OpenPKG Specs: openpkg/build.pl@c10fb90893b9 (annotated)

openpkg/build.pl@c10fb90893b9 (annotated)

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.

 ##
 ##  build.pl -- OpenPKG Package Building and Installing
 ##  Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
 ##
 ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
 ##  All rights reserved. Licenses which grant limited permission to use,
 ##  copy, modify and distribute this software are available from the
 ##  OpenPKG GmbH.
 ##
 ##  THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
 ##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 ##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
 ##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
 ##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 ##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 ##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
 ##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
 ##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 ##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
 ##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 ##  SUCH DAMAGE.
 ##
 #############################################################################
 ##
 ##  MAIN PROCEDURE
 ##
 #############################################################################
 require 5;
 #use strict;
 my (
    $opt_h,
    $opt_R, $opt_r, $opt_f, $opt_u, $opt_U, $opt_a, $opt_A,
    $opt_z, $opt_Z, $opt_P, $opt_N, $opt_E, $opt_H, $opt_i,
    $opt_D, $opt_p, $opt_q, $opt_s, $opt_S, $opt_X, $opt_M,
    $opt_L, $opt_W, $opt_K, $opt_e, $opt_b, $opt_B, $opt_g,
    $opt_k
 );
 #   global context variables
 my $prg = "openpkg build";
 my %env = ('' => {});
 ##
 ##  OPTION PARSING
 ##
 #   parse command line options
 my $getopts = 'hR:r:f:uUaAzZP:N:E:H:iD:p:qsSXMLWKebBgk';
 getopts($getopts);
 #   parse configuration script options
 if (open(FH, "<$ENV{'HOME'}/.openpkg/build")) {
     my ($env) = $env{''};
     my ($go) = $getopts;
     $go =~ s/[^a-zA-Z]//g;
     while (my $line = <FH>) {
         if ($line =~ m/^\s*\[([^\]]*)\]/) {
             $env{$1} = {} unless ($env{$1});
             $env = $env{$1};
         } elsif (my ($opt, $val) = ($line =~ m/^\-([$go])\s*(.*?)\s*$/)) {
             $val = 1 unless (defined($val));
             if (exists($env->{$opt})) {
                 $env->{$opt} .= " " . $val;
             } else {
                 $env->{$opt} = $val;
             }
         }
     }
     close(FH);
 }
 #   usage sanity check and usage help
 sub usage {
     my ($rc) = @_;
     my $usage =
         "openpkg:build:USAGE: $prg [options] [pattern ...]\n" .
         " -a                operate on all installed packages\n" .
         " -A                operate on all repository packages\n" .
         " -R <rpm>          path to \"openpkg rpm\" command\n" .
         " -r <repository>   URL to package repository directory\n" .
         " -f <index.rdf>    URL to package repository index file\n" .
         " -u                ignore local binary RPMs\n" .
         " -U                upgrade all selected packages including dependencies\n" .
         " -z                rebuild from zero all selected installed packages\n" .
         " -Z                rebuild from zero all selected available packages\n" .
         " -i                ignore errors in the generated script\n" .
         " -q                ignore all reverse dependencies\n" .
         " -s                generate status map instead of shell script\n" .
         " -S                generate status map instead of shell script (including new)\n" .
         " -X                use external XML/RDF parser instead of internal one\n" .
         " -M                generate short dependency map instead of shell script\n" .
         " -L                generate list of packages in repository depending on target\n" .
         " -W                include dependencies as if all build options are enabled\n" .
         " -K                keep temporarily installed packages\n" .
         " -k                keep temporarily downloaded packages\n" .
         " -e                rebuild exact version of a package from repository\n" .
         " -b                build-time check existing binaries for dependencies only\n" .
         " -B                build-time check existing binaries for dependencies and target\n" .
         " -g                rebuild packages even when most recent version is installed\n" .
         " -P <priv-cmd>     command prefix for privileged commands\n" .
         " -N <non-priv-cmd> command prefix for non-privileged commands\n" .
         " -p <platform>     match platform against repository index for binary packages\n" .
         " -E <name>         exclude package\n" .
         " -H <name>         hint about packages to resolve ambiquity\n" .
         " -D <name>[=<val>] set build option for packages\n";
     if ($rc == 0) {
         print STDOUT $usage;
     }
     else {
         print STDERR $usage;
     }
     exit($rc);
 }
 if ($opt_h) {
     usage(0);
 }
 if (not (   ($#ARGV >= 0  && !($opt_a || $opt_A))
          || ($#ARGV == -1 &&  ($opt_a || $opt_A)))) {
     usage(1);
 };
 #   determine RPM run-time information
 my $config = rpm_runtime_info();
 #   override command line options with configuration script options
 #   now that the effectively used OpenPKG RPM command is known
 foreach my $env (sort { $a cmp $b } grep {
        $config->{"rpm"}    =~ m/^\Q$_\E/ # compatibility
     or $config->{"prefix"} =~ m/^\Q$_\E/ # regular
 } keys %env) {
     while (my ($opt, $val) = each(%{$env{$env}})) {
         eval "\$opt_$opt = '$val' unless defined \$opt_$opt;";
     }
 }
 ##
 ##  OPTION POST-PROCESSING
 ##
 my ($url, $repository, $installed, $env, $list, $bonly, $clist);
 my ($pattern, %with, %exclude, %hint);
 #   determine package goal pattern
 if ($opt_a) {
     $pattern = undef;
 } else {
     $pattern = join(' ', @ARGV);
 }
 if ($opt_A) {
     $pattern = '*';
 }
 #   parse build options
 %with = map {
       m/([^\s=]+)(?:\=(\S+))?/
     ? ($1 => (defined($2) ? $2 : 'yes'))
     : ()
 } split(/\s+/, $opt_D);
 #   split accumulated option values
 %exclude = map { $_ => 1 } split(/\s+/, $opt_E);
 %hint    = map { $_ => 1 } split(/\s+/, $opt_H);
 if (defined($opt_p)) {
     $config->{platform} = $opt_p;
 }
 #   determine RPM package repository information
 if (defined $opt_r) {
     $url = $opt_r;
     $url .= '/' unless $url =~ m/\/$/;
 } else {
     $url = rpm_release_url();
 }
 #   if we read the index from a file we can no longer deduce
 #   repository paths from index paths. For now lets assume
 #   that everything is below SRC/ to be compatible with
 #   existing file indexes.
 if (defined($opt_f) and not defined($opt_r)) {
     $url .= 'SRC/';
 }
 #   determine information about INSTALLED packages (virtual and regular),
 #   including their options, provides and requirements
 my $installed = get_installed();
 #   SPECIAL CASE post-processing for
 #   -Z (ignore installed packages)
 #   -a (operate for all installed packages)
 if ($opt_a and $opt_Z) {
     #   This allows one to correctly upgrade an existing OpenPKG
     #   instance to a newer major version by querying all installed
     #   packages and their options (-a) but then ignore them (-Z) during
     #   the later processing and instead perform more or less a fresh
     #   rebuild from scratch. This ensures that during the process the
     #   installed packages are effectively picked up as dependencies
     #   only after they in turn were already updated.
     foreach my $package (keys(%{$installed})) {
         next if ($package =~ m/::/);
         if (exists($installed->{$package}->{""})) {
             #   virtual package
             $hint{$installed->{$package}->{""}->[0]->{"name"}} = 1
                 if (exists($installed->{$package}->{""}->[0]->{"name"}));
         }
         else {
             #   regular package
             $pattern .= " $package";
             foreach my $version (keys(%{$installed->{$package}})) {
                 foreach my $rec (@{$installed->{$package}->{$version}}) {
                     if (defined($rec->{"OPTIONS"})) {
                         my $options = $rec->{"OPTIONS"};
                         foreach my $option (keys(%{$options})) {
                             $with{$package."::".$option} = $options->{$option};
                         }
                     }
                 }
             }
         }
     }
 }
 if ($opt_Z) {
     $installed = {};
 }
 #   determine information about AVAILABLE packages
 #   by fetching and parsing a package repository XML/RDF index
 $repository = get_index(
     $url . '00INDEX.rdf',
     $opt_f,
     $opt_X,
     $config->{platform},
     $installed
 );
 #   assemble together all determined environment information
 $env = {
     config     => $config,
     installed  => $installed,
     repository => $repository,
     built      => {},
     revdep     => undef,
     with       => \%with,
     exclude    => \%exclude,
     hint       => \%hint,
     upgrade    => ($opt_a || $opt_U),
     zero       => ($opt_z || $opt_Z),
     exact      => $opt_e,
     quick      => ($opt_q || $opt_z || $opt_Z),
     status     => ($opt_s || $opt_S),
     fatal      => [],
     goals      => $opt_g,
     sourceonly => ($opt_u || $opt_U || $opt_z || $opt_Z)
 };
 ##
 ##  PERFORM REQUESTED OPERATION
 ##
 if ($opt_L) {
     #   case 1: calculate dependencies only and
     #           print packages depending on target
     ($list) = build_deps($pattern, $env);
     print_deps($list);
 } else {
     #   case 2: calculate build commands and
     #           print results in different formats
     ($list, $bonly, $clist) = build_list($pattern, $env);
     die "openpkg:build:FATAL: cannot find package\n" if (not defined($list));
     if ($opt_M) {
         print_map($installed, $repository, $list, $bonly, $clist);
     } elsif ($opt_S) {
         print_status($installed, $repository, $list, $bonly, $clist);
     } elsif ($opt_s) {
         print_status($installed, {}, $list, $bonly, $clist);
     } else {
         if (@{$env->{fatal}}) {
             die "openpkg:build:FATAL: errors occured while building:\n", @{$env->{fatal}}, "\n";
         }
         print_list1($list, $config, $opt_a || $opt_u || $opt_U, $env->{with}, $opt_i, $opt_b, $opt_B);
         print_list2($bonly, $config) if (not $opt_K);
     }
 }
 #   die gracefully
 exit(0);
 #############################################################################
 ##
 ##  FUNCTIONS: PARSING & RUN-TIME INFORMATION
 ##
 #############################################################################
 #   home-brewn getopt(3) style option parser
 sub getopts ($) {
     my ($opts) = @_;
     my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\w:|\w)/g;
     my (%opts, @argv, $optarg);
     foreach (@ARGV) {
         if (@argv) {
             push @argv, $_;
         } elsif (defined $optarg) {
             if (exists $opts{$optarg}) {
                 $opts{$optarg} .= " $_";
             } else {
                 $opts{$optarg} = $_;
             }
             $optarg = undef;
         } elsif (!/^[-]/) {
             push @argv, $_;
         } else {
             while (/^\-(\w)(.*)/) {
                 if (exists $optf{$1}) {
                     if (length($optf{$1}) > 1) {
                         if ($2 ne '') {
                             if (exists $opts{$1}) {
                                 $opts{$1} .= " $2";
                             } else {
                                 $opts{$1} = $2;
                             }
                         } else {
                             $optarg = $1;
                         }
                         last;
                     } else {
                         $opts{$1} = 1;
                     }
                 } else {
                     warn "openpkg:build:WARNING: unknown option $_\n";
                 }
                 $_ = "-$2";
             }
         }
     }
     if (defined $optarg) {
         warn "openpkg:build:WARNING: option $optarg requires an argument\n";
     }
     foreach (keys %opts) {
         eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
     }
     @ARGV = @argv;
 }
 #   determine RPM run-time information
 sub rpm_runtime_info () {
     #   determine OpenPKG instance prefix via
     #   1. the environment of the "openpkg build" framework
     #   2. the installation path of the script
     #   3. the installation path of the Perl interpreter
     #   4. the path of the "openpkg" command in $PATH
     my $l_prefix = $ENV{'OPENPKG_PREFIX'};
     if (not $l_prefix) {
         ($l_prefix) = ($0 =~ m/^(.+)\/lib(exec)?\/openpkg(-tools)?\/build(\.pl)?$/);
     }
     if (not $l_prefix) {
         ($l_prefix) = ($^X =~ m/^(.+)\/bin\/perl.*$/);
     }
     if (not $l_prefix) {
         $l_prefix = (`(which openpkg) 2>/dev/null` =~ m/^(.+)\/bin\/openpkg$/);
     }
     if (not -x "$l_prefix/bin/openpkg") {
         die "openpkg:build:FATAL: cannot determine OpenPKG instance prefix";
     }
     print "# operating with OpenPKG instance $l_prefix\n";
     #   determine OpenPKG RPM command
     my $rpm = $opt_R || $env{''}->{'R'} ||
         ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/openpkg/rpm") ?
         "$l_prefix/bin/openpkg rpm" : "$l_prefix/bin/rpm");
     $rpm = (`(which $rpm) 2>/dev/null` =~ m{^(/.*)})[0] if ($rpm !~ m|^/|);
     die "openpkg:build:FATAL: cannot locate OpenPKG RPM in path" unless ($rpm =~ m{^/});
     print "# operating with OpenPKG RPM $rpm\n";
     #   determine additional tools
     my $mkp = "$l_prefix/bin/openpkg makeproxy";
     my $rel = "$l_prefix/bin/openpkg release";
     my $bzip2 = $rpm;
     $bzip2 =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/bzip2/;
     my $curl = $rpm;
     $curl =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/curl/;
     $curl = "$l_prefix/bin/openpkg curl" if (system("$l_prefix/bin/openpkg curl file://$l_prefix/etc/openpkg/platform >/dev/null 2>&1") == 0);
     #   expand RPM macros holding information
     my $c = run("$rpm --eval '%{_rpmdir} %{_rpmfilename} %{_target_os} %{_target_cpu} %{_srcrpmdir}'");
     #   parse and post-process information
     chomp($c);
     my (@q) = split(/\s+/, $c);
     $q[1] =~ s/%{OS}/$q[2]/;
     $q[1] =~ s/%{ARCH}/$q[3]/;
     #   expand RPM rc information about tools
     $c = run("$rpm --showrc");
     my @g = ($c =~ m/\%\{l_tool_locate\s+([^\s\}]+)/g);
     #   return accumulated information
     return {
         rpm      => $rpm,
         mkp      => $mkp,
         rel      => $rel,
         bzip2    => $bzip2,
         curl     => $curl,
         rpmdir   => $q[0],
         srcrpmdir=> $q[4],
         template => $q[1],
         platform => '',
         prefix   => $l_prefix,
         optreg   => '(?:'. join('|', map { "\Quse_$_\E" } @g) .')'
     };
 }
 #   determine RPM release URL
 sub rpm_release_url ($$) {
     my ($rel, $url);
     #   determine the release URL the newer way
     $url = run("(".$config->{"rel"}." --fmt='%u') 2>/dev/null || true") || "";
     $url =~ s/^\s+//s;
     $url =~ s/\s+$//s;
     #   use a local jumpstart RDF
     if (-f $config->{"prefix"}."/etc/openpkg/build.rdf") {
         $url = "file://".$config->{"prefix"}."/etc/openpkg/build.rdf"
     }
     return $url;
 }
 #############################################################################
 ##
 ##  FUNCTIONS: VERSION STRING HANDLING
 ##
 #############################################################################
 #   compare two package versions
 #   - "openpkg rpm":
 #     splits according to !isalnum(3) ([a-zA-Z0-9])
 #     and between isdigit(3) ([0-9]) and isalpha(3) ([a-zA-Z])
 #   - "openpkg build" (this):
 #     splits on "." characters
 sub vcmp_version ($$) {
     my ($a, $b) = @_;
     my (@a, @b, $c);
     my ($ax, $bx);
     #   split according to dots
     @a = split(/\./, $a);
     @b = split(/\./, $b);
     #   compare as long as components exist
     while (@a && @b) {
         if ($a[0] =~ m/^\d+$/ && $b[0] =~ m/^\d+$/) {
             #   numerical comparison
             $c = $a[0] <=> $b[0];
         } elsif ((($a, $ax) = $a[0] =~ m/^(\d+)(.*)$/) &&
                  (($b, $bx) = $b[0] =~ m/^(\d+)(.*)$/)) {
             #   numerical comparison for prefix,
             #   string comparison for remainder
             $c = $a <=> $b;
             $c = $ax cmp $bx unless ($c);
         } else {
             #   string comparison
             $c = $a[0] cmp $b[0];
         }
         #   stop comparison if components already mismatched
         return $c if ($c != 0);
         #   else reduce by one component level
         shift(@a);
         shift(@b);
     }
     #   finally compare number of remaining components
     #   (in case one is more specific)
     $c = (scalar(@a) <=> scalar(@b));
     return $c;
 }
 #   compare two package releases
 #   - "openpkg rpm":
 #     uses "vcmp_version" semantics 1:1 again
 #   - "openpkg build" (this):
 #     uses "vcmp_version" semantics 1:1 again (>= 20060719)
 #     trivial string comparison               (<= 20060719)
 sub vcmp_release ($$) {
     my ($a, $b) = @_;
     return vcmp_version($a, $b);
 }
 #   compare two package "version" or "version-release" strings
 #   - "openpkg rpm":
 #     compares "epoch", "version", "release" (in this order)
 #   - "openpkg build" (this):
 #     compares "release", "version", (in this order)
 sub vcmp ($$) {
     my ($a, $b) = @_;
     my ($c);
     #   short-circuit comparison for simple case
     return 0 if ($a eq $b);
     #   split into "version" and "release"
     my ($av, $ar) = ($a =~ m/^(.*?)(?:\-([\d\.]+))?$/);
     my ($bv, $br) = ($b =~ m/^(.*?)(?:\-([\d\.]+))?$/);
     #   compare "release"
     if (defined($ar) and defined($br)) {
         $c = vcmp_release($ar, $br);
         return $c if ($c); # short-circuit
     }
     #   compare "version"
     if (defined($av) && defined($bv)) {
         $c = vcmp_version($av, $bv);
         return $c if ($c); # short-circuit
     }
     #   equality
     return 0;
 }
 #   create "version" or "version-release" string
 #   from a provide object (see parse_provides)
 sub vs ($) {
     my ($t) = @_;
     return (
           defined($t->{release})
         ? "$t->{version}-$t->{release}"
         : $t->{version}
     );
 }
 #   create "name-version" or "name-version-release" string
 #   from a provide object (see parse_provides)
 sub vsn ($) {
     my ($t) = @_;
     return "$t->{name}-".vs($t);
 }
 #############################################################################
 ##
 ##  FUNCTIONS: INSTALLATION INFORMATION
 ##
 #############################################################################
 #   parse OpenPKG RPM 'provide' string
 #   "<virtual-name>"               (virtual package)
 #   "<name> = <version>-<release>" (regular package)
 #   "<name>::<option> = <value>"   (regular package build option)
 sub parse_provides ($) {
     my ($s) = @_;
     my ($nam, $val, $pre, $with, $pxy, $ver, $rel);
     ($nam, $val) = ($s =~ m/^([^\s\(]+(?:\([^\)]*\))?)\s*(?:=\s*(\S*?))?$/);
     if (($pre, $with) = ($nam =~ m/^(\S+?)::(\S*)$/)) {
         #   build option
         $val =~ s/(?:\%([0-9a-fA-F][0-9a-fA-F]))/chr(hex($1))/eg; # hex decode
         ($ver, $rel, $pxy) = ($val, undef, undef);
     } else {
         #   virtual or real package
         ($ver, $rel, $pxy) = ($val =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
     }
     #   return accumulated information
     return {
         name    => $nam,     # the full name of the resource
         version => $ver,     # the version        (or value)
         release => $rel,     # and release number (or undef)
         proxy   => $pxy,     # whether the resource is a PROXY resource (or undef)
         prefix  => $pre,     # the packagename (if resource is an option)
         with    => $with     # the buildoption (if resource is an option)
     };
 }
 #   parse option from RPM 'provides' list
 sub parse_provideslist ($) {
     my ($l) = @_;
     my ($p);
     my ($nam, $val, %opts);
     foreach (@$l) {
         $p = parse_provides($_);
         next if (not (defined $p->{with} && defined $p->{prefix}));
         $opts{$p->{with}} = $p->{version};
     }
     return \%opts;
 }
 #   translate dependency object into provides object
 sub depends2provides ($) {
     my ($dep) = @_;
     my ($ver, $rel, $pxy, $pre, $with);
     ($ver, $rel, $pxy) = ($dep->{val} =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
     ($pre, $with) = ($dep->{name} =~ m/^(\S+?)::(\S*)$/);
     return {
         name    => $dep->{name},
         version => (defined $ver ? $ver : $dep->{val}),
         release => $rel,
         proxy   => $pxy,
         prefix  => $pre,
         with    => $with
     }
 }
 #   parse OpenPKG RPM 'require' string
 #   "<virtual-name>"                              (virtual package)
 #   "<name> =|<|<=|>|>= <version>[-<release>]"    (regular package)
 #   "<name>::<option> =|<|<=|>|>= <value>"        (regular package build option)
 sub parse_depends ($) {
     my ($dep) = @_;
     my ($name, $op, $val);
     if (ref($dep)) {
         #   dependency from new index stored as a node
         #   - content of the node is the name
         #   - certain attributes denote the comparison operator
         #   - the value of such an attribute is the comparison operand
         #   - the operator (and operand) are optional and there can only be one
         $name = $dep->{content};
         $op = undef;
         $op = 'equ' if (exists($dep->{equ}));
         $op = 'geq' if (exists($dep->{geq}));
         $op = 'leq' if (exists($dep->{leq}));
         $op = 'gt'  if (exists($dep->{gt}));
         $op = 'lt'  if (exists($dep->{lt}));
         if (defined($op)) {
             $val = $dep->{$op};
         }
     } elsif ($dep =~ m/\S/) {
         #   dependency from old index stored as text string
         #   "name operator operand" or "name"
         ($name, $op, $val) = ($dep =~ m/(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/);
         if (defined($op)) {
             $op = {
                 '=='  => 'equ', '='   => 'equ',
                 '>='  => 'geq', '=>'  => 'geq',
                 '<='  => 'leq', '=<'  => 'leq',
                 '>'   => 'gt',  '<'   => 'lt'
             }->{$op};
             if (not defined($op)) {
                 print "# don't know how to handle dependency: $dep (invalid operator)\n";
                 return;
             }
         }
     }
     return {
         name => $name,
         op   => $op,
         val  => $val
     };
 }
 #   retrieve the local installed package base.
 #   for packages that provide option resources (packagename::buildoption)
 #   the options are parsed into the OPTIONS hash.
 #   other packages will query options on demand.
 sub get_installed () {
     my (%map);
     my (@l, $p);
     my ($nam, $val, %options);
     my ($vs, $rec, @list);
     my ($name, $version, $release);
     my ($req);
     #   generated total result:
     #   $map = {
     #       #   regular package
     #       "<package-name>" <foo> => {
     #            "<version>-<release>" <1.2.3-20060622> => [
     #                <<1>{
     #                    "name"    => $name,
     #                    "version" => $version,
     #                    "release" => $release,
     #                    "PROXY"   => $proxy,
     #                    "depends" => [
     #                          <<3>>{
     #                              "cond"  => '',
     #                              "value" => {
     #                                  name => $name,
     #                                  op   => $op,
     #                                  val  => $val
     #                              },
     #                          },
     #                          ...
     #                    ],
     #                    "keeps" => [
     #                          \<<3>
     #                          ...
     #                    ],
     #                    "OPTIONS" => {
     #                        "<option>" => "<value>",
     #                        "<option>" => "<value>",
     #                        ...
     #                    },
     #                },
     #                ...
     #            ],
     #       },
     #       #   build option
     #       "<package-name>::<option>" <foo::with_baz> => {
     #            "<value>" <yes> => [
     #                \<<1>>
     #                ...
     #            ],
     #       },
     #       #   virtual package
     #       "<package-name>" <BAR> => {
     #            "" => [
     #                \<<1>>,
     #                ...
     #            ],
     #       },
     #       ...
     #   };
     #   query and parse all provides of all packages
     #   HINT: We assume(!) that OpenPKG RPM outputs "provides" in order:
     #         1. virtual package & build option
     #         2. regular package
     #   FIXME: The better long-term solution for all this fiddling would be something like:
     #          "openpkg rpm -qa -qf '%{NAME} %{VERSION} %{RELEASE}[ .%{PROVIDENAME} .%{PROVIDEFLAGS:depflags} .%{PROVIDEVERSION}]\\n'"
     @l = run($config->{"rpm"}. " --provides -qa");
     @list = ();
     foreach (@l) {
         #   parse into provide object
         $p = parse_provides($_) or next;
         #   short-circuit processing for RPM special case
         next if ($p->{name} =~ m/^gpg\(/);
         #   is this an option?
         if (defined($p->{with})) {
             $options{$p->{prefix}}->{$p->{with}} = $p->{version};
             push(@list, $p);
             next;
         }
         #   is this a virtual target?
         $vs = vs($p);
         if ($vs eq '') {
             push(@list, $p);
             next;
         }
         #   assemble package details
         $name    = $p->{name};
         $version = defined($p->{version}) ? $p->{version} : '*';
         $release = defined($p->{release}) ? $p->{release} : '*';
         push(@list, {
             name    => $name,
             version => $version,
             release => $release
         });
         #   create target record
         $rec = {
             name       => $name,
             version    => $version,
             release    => $release,
             PROXY      => $p->{proxy},
             depends    => [],
             keeps      => []
         };
         foreach (@list) {
             push(@{$map{$_->{name}}->{vs($_)}}, $rec);
         }
         #   remove assembled details
         @list = ();
     }
     if (@list) {
         print "# ATTENTION: ", scalar(@list), " froods (unassignable RPM 'provides') left\n";
     }
     #   options are provided for a package,
     #   apply them to all instances of the package
     #   FIXME: duplicate copying because record exists multiple times (but harmless)
     #   FIXME: merges all "provides" of all package instances together -- which might be wrong
     foreach $nam (keys(%options)) {
         foreach $val (keys(%{$map{$nam}})) {
             foreach (@{$map{$nam}->{$val}}) {
                 $_->{OPTIONS} = $options{$nam};
             }
         }
     }
     #   query all 'requires' of all installed packages
     #   to determine the package dependencies
     @l = run($config->{"rpm"} . " --qf '%{NAME}:::%{VERSION}:::%{RELEASE}[ :::%{REQUIRENAME}:::%{REQUIREFLAGS:depflags}:::%{REQUIREVERSION}:::]\\n' -qa");
     @list = ();
     foreach (@l) {
         ($name, $version, $release, $req) = m/^([^:]+):::([^:]+):::([^:]+)(.*?)$/;
         next if ($name eq 'gpg-pubkey');
         $release =~ s/\+PROXY$//;
         #   for each requirement triple...
         while ($req =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
             $p = parse_depends("$1 $2 $3");
             next if ($p->{name} =~ m/^(rpmlib|gpg)\(/);
             $vs = vs({ version => $version, release => $release });
             $p = { cond => '', value => $p };
             foreach $rec (@{$map{$name}->{$vs}}) {
                 push(@{$rec->{depends}}, $p);
                 push(@{$rec->{keeps}},   $p);
             }
         }
     }
     if (@list) {
         print "# ATTENTION: ",scalar(@list)," fnords (unassignable RPM 'requires') left\n";
     }
     #   return final result
     return \%map;
 }
 #############################################################################
 ##
 ##  FUNCTIONS: REPOSITORY INDEX INFORMATION
 ##
 #############################################################################
 #   fetch XML/RDF index from file or URL
 #   (recursively fetches sub-indexes, too)
 sub get_index ($$$$$) {
     my ($url, $fn, $xml, $pfmatch, $installed) = @_;
     my (%map, $include);
     my ($fetch, $bzip2, $path);
     my ($parser);
     #   determine command/path to fetch/open index
     $bzip2 = $config->{"bzip2"};
     $fetch = defined($fn) ? $fn : $url;
     $fetch !~ m/\.bz2$/ || -x $bzip2
         or die "openpkg:build:FATAL: $bzip2 not found\n";
     if ($fetch =~ m/^\w+:/) {
         #   looks like URL scheme
         print "# fetching XML/RDF index from URL $fetch\n";
         $path = $config->{"curl"} . " -s -o - \"$fetch\" |";
         $path .= "$bzip2 -dc |" if ($fetch =~ m/\.bz2$/);
     } else {
         print "# reading XML/RDF index from file $fetch\n";
         if ($fetch =~ m/\.bz2$/) {
             $path = "$bzip2 -dc $fetch |";
         } else {
             $path = "<$fetch";
         }
     }
     #   open index
     open(RFH, $path) or
         die "openpkg:build:FATAL: cannot open '$fetch' ($!)\n";
     #   if XML parser can be used, try to lazy-load it
     if ($xml) {
         eval { require XML::Simple; };
         $xml = 0 if ($@);
     }
     #   determine and run XML parser
     #   (returns contained index includes)
     $parser = ($xml ? \&xml_parser : \&simple_text_parser);
     $include = $parser->(\*RFH, $url, \%map, $pfmatch, $installed);
     #   close index
     close(RFH)
         or die "openpkg:build:FATAL: an I/O error occured\n";
     #   cannot do real recursions on file handles, so we simply append
     #   (instead of inserting at the correct position) all sub-RDFs, as
     #   the result is flattend into a big hash anyway
     foreach (@$include) {
         my ($submap);
         my ($suburl, $subfn) = relurl($url, $fn, $_);
         $submap = get_index($suburl, $subfn, $xml, $pfmatch, $installed); # RECURSION
         while (my ($name, $vmap) = each(%$submap)) {
             while (my ($vs, $recs) = each(%$vmap)) {
                 push(@{$map{$name}->{$vs}}, @$recs);
             }
         }
     }
     #   return final result
     #   $map = {
     #       <package-name> => {
     #           "<version>-<release>" => {
     #                href      => ...,
     #                name      => ...,
     #                version   => ...,
     #                release   => ...,
     #                platform  => ...,
     #                prefix    => ...,
     #                depends   => [ ... ],
     #                keeps     => [ ... ],
     #                conflicts => [ ... ],
     #                source    => ...,
     #                nosource  => ...,
     #                desc      => $desc,
     #                OPTIONS   => $options,
     #                DEFOPTS   => { %$options },
     #           };
     #       };
     #   };
     return \%map;
 }
 #   compute absolute paths
 #   - (url, fn) point to a base document
 #     the location is the file path fn if fn is
 #     defined, otherwise it is url.
 #   - augment the pointer with suburl
 #   - suburl can be an absolute url
 #     then the new pointer is (suburl, undef)
 #   - suburl can be a absolute file path
 #     then the new pointer is (suburl, suburl)
 #   - suburl can be a relative path
 #     then it augments url or fn accordingly
 sub relurl ($$$) {
     my ($url, $fn, $suburl) = @_;
     my ($subfn);
     if ($suburl =~ m/^\w+:\/\//) {
         # NOP
     } elsif ($suburl =~ m/^\//) {
         $subfn = $suburl;
     } else {
         if (defined($fn)) {
             $subfn = $fn;
             $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
             $suburl = $subfn;
         } else {
             $subfn = $url;
             $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
             $suburl = $subfn;
             $subfn  = undef;
         }
     }
 while ($suburl =~ s/\/\.\//\//s);
 while ($suburl =~ s/\/[^\/]+\/\.\.\//\//s);
     return ($suburl, $subfn);
 }
 #   XML/RDF parser (simple way)
 sub simple_text_parser ($$$$$) {
     my ($fh, $url, $map, $pfmatch, $installed) = @_;
     my (@include);
     my ($section);
     my ($name, $version);
     my ($href, $release, $desc, $bags);
     my (%options, @provides);
     my ($platform, $prefix);
     my ($rec);
     my ($tag, $cond, $attrname, $attrval, $body);
     my ($usecond);
     my ($options);
     print "# using internal XML/RDF parser\n";
     #   read XML/RDF line-wise as we know that our
     #   OpenPKG XML/RDF indices follow a strict formatting
     while (<$fh>) {
         #   unescape some XML entities
         s/&gt;/>/g;
         s/&lt;/</g;
         if (!(defined($href)) && m/<rdf:Description.*?href="([^"]*)"/) {
             #   start of new package description
             $href      = $1;
             $section   = undef;
             $name      = undef;
             $release   = undef;
             $desc      = '';
             $platform  = undef;
             $prefix    = undef;
             $bags      = {};
             @provides  = ();
         }
         if (!(defined($href)) && m/<Repository.*?href="([^"]*)"(?:\s*platform="([^"]*)")?/) {
             #   external XML/RDF index reference for particular binary platform
             if (goodpf($2, $pfmatch)) {
                 push(@include, $1);
             }
             next;
         }
         #   skip content unless referenced piece was found
         next if (not defined($href));
         #   parse XML/RDF element into components
         ($tag, $cond, $attrname, $attrval, $body) = m{
             <                      # start delimiter
             (\/?[\w:]+)            # begin element name
             \s*                    # optional space before attributes
             (?:cond="([^"]+)")?    # known attribute
             (?:(\w+)="([^"]+)")?   # unknown attribute
             >                      # end delimiter
             (.*?)                  # optional element body
             (?:<\/\1>)?            # optional end tag
             $                      # end of string
         }mx;
         #   recognize the various XML/RDF elements
         if ($tag eq 'Description') {
             $usecond = $cond;
             $section = 'description';
         } elsif ($tag eq '/Description') {
             $usecond = $cond;
             $section = undef;
         } elsif ($section eq 'description') {
             $desc .= $_;
         } elsif ($tag eq 'PreReq') {
             $usecond = $cond;
             $section = 'prereq';
         } elsif ($tag eq '/PreReq') {
             $usecond = undef;
             $section = undef;
         } elsif ($tag eq 'BuildPreReq') {
             $usecond = $cond;
             $section = 'bprereq';
         } elsif ($tag eq '/BuildPreReq') {
             $usecond = undef;
             $section = undef;
         } elsif ($tag eq 'Provides') {
             $usecond = $cond;
             $section = 'provides';
         } elsif ($tag eq '/Provides') {
             $usecond = undef;
             $section = undef;
         } elsif ($tag eq 'Conflicts') {
             $usecond = $cond;
             $section = 'conflicts';
         } elsif ($tag eq '/Conflicts') {
             $usecond = undef;
             $section = undef;
         } elsif ($tag eq 'NoSource') {
             $usecond = $cond;
             $section = 'nosource';
         } elsif ($tag eq '/NoSource') {
             $usecond = undef;
             $section = undef;
         } elsif ($tag eq 'Source') {
             $usecond = $cond;
             $section = 'source';
         } elsif ($tag eq '/Source') {
             $usecond = undef;
             $section = undef;
         } elsif ($tag eq 'Name') {
             $name = $body;
         } elsif ($tag eq 'Version') {
             $version = $body;
         } elsif ($tag eq 'Release') {
             $release = $body;
         } elsif ($tag eq 'Platform') {
             $platform = $body;
         } elsif ($tag eq 'Prefixes') {
             $prefix = $body;
         } elsif ($tag eq 'rdf:li' || $tag eq 'resource') {
             if (defined($attrname)) {
                 $body = {
                     $attrname => $attrval,
                     content   => $body
                 };
             }
             if ($section eq 'provides') {
                 push(@provides, $body) if (!defined($usecond));
             } elsif ($section ne '') {
                 push(@{$bags->{"$usecond"}->{$section}}, $body);
             }
         } elsif ($tag eq '/rdf:Description') {
             if (   defined($href)
                 && defined($name)
                 && defined($version)
                 && defined($release)) {
                 #   process the accumulated package information
                 @provides = map {
                     depends2provides(parse_depends($_))
                 } @provides;
                 %options = map {
                     ($_->{with} => $_->{version})
                 } grep {
                     defined($_->{with})
                 } @provides;
                 push(@provides, {
                     name    => $name,
                     version => $version,
                     release => $release
                 });
                 $options =
                       %options
                     ? { %options }
                     : parse_options($desc);
                 if ($options) {
                     my (@t) = get_targets($installed->{$name}, sub { 1; });
                 }
                 #   store accumulated package information
                 eval {
                     $rec = {
                         href      => (relurl($url, undef, $href))[0],
                         name      => $name,
                         version   => $version,
                         release   => $release,
                         depends   => depend_list(swith($bags, 'bprereq')),
                         keeps     => depend_list(swith($bags, 'prereq')),
                         conflicts => swith($bags, 'conflicts'),
                         source    => swith($bags, 'source'),
                         nosource  => swith($bags, 'nosource'),
                         desc      => $desc,
                         platform  => $platform,
                         prefix    => $prefix,
                         OPTIONS   => $options,
                         DEFOPTS   => { %$options }
                     };
                 };
                 if ($@) {
                     die "openpkg:build:FATAL: when reading entry '$name':\n" . $@;
                 }
                 foreach (@provides) {
                     push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
                 }
             }
             #   prepare to recognize next package
             $href = undef;
         }
     }
     #   return contained XML/RDF indices
     return \@include;
 }
 #   XML/RDF parser (usual way)
 sub xml_parser ($$$$$) {
     my ($fh, $url, $map, $pfmatch, $installed) = @_;
     my (@include);
     my ($xml, $rep, $sub);
     my (@provides, %options, $rec);
     my ($href, $name, $version, $release, $desc);
     my ($options);
     print "# using external XML/RDF parser\n";
     #   parse XML/RDF with XML::Simple parser
     $xml = XML::Simple::XMLin($fh, forcearray => 1);
     $rep = $xml->{'Repository'}->[0]->{'rdf:Description'};
     $sub = $xml->{'Repository'}->[0]->{'Repository'};
     #   iterate over all package descriptions
     foreach (@$rep) {
         #   fetch package information
         $href    = $_->{'href'};
         $name    = xel($_->{'Name'});
         $version = xel($_->{'Version'});
         $release = xel($_->{'Release'});
         next if (not (
                defined($href)
             && defined($name)
             && defined($version)
             && defined($release)
         ));
         #   determine package "provides"
         @provides = ();
         if ($_->{'Provides'}) {
             @provides = map {
                 $_ = $_->{'rdf:bag'}->[0];
                 $_ = $_->{'rdf:li'} ? $_->{'rdf:li'} : $_->{'resource'};
                 @$_;
             } grep {
                 !exists $_->{'cond'}
             } @{$_->{'Provides'}};
         }
         @provides = map {
             depends2provides(parse_depends($_))
         } @provides;
         %options = map {
             ($_->{with} => $_->{version})
         } grep {
             defined $_->{with}
         } @provides;
         push(@provides, {
             name    => $name,
             version => $version,
             release => $release
         });
         #   determine targets
         $desc = xel($_->{'Description'});
         $options =
               %options
             ? { %options }
             : parse_options($desc);
         if ($options) {
             my (@t) = get_targets($installed->{$name}, sub { 1; });
         }
         #   store accumulated package information
         eval {
             $rec = {
                 href      => (relurl($url, undef, $href))[0],
                 name      => $name,
                 version   => $version,
                 release   => $release,
                 platform  => xel($_->{'Platform'}),
                 prefix    => xel($_->{'Prefixes'}),
                 depends   => depend_list(xwith($_->{'BuildPreReq'})),
                 keeps     => depend_list(xwith($_->{'PreReq'})),
                 conflicts => xwith($_->{'Conflicts'}),
                 source    => xwith($_->{'Source'}),
                 nosource  => xwith($_->{'NoSource'}),
                 desc      => $desc,
                 OPTIONS   => $options,
                 DEFOPTS   => { %$options }
             };
         };
         if ($@) {
             die "openpkg:build:FATAL: when reading entry '$name'\n".$@;
         }
         foreach (@provides) {
             push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
         }
     }
     #   determine contained XML/RDF indices
     if ($sub) {
         @include = map {
             goodpf($_->{platform}, $pfmatch)
             ? ( $_->{href} )
             : ( )
         } @$sub;
     }
     #   return contained XML/RDF indices
     return \@include;
 }
 #   convert XML parser output to dependency records
 sub depend_list ($) {
     my ($dl) = @_;
     foreach (@$dl) {
         $_->{value} = parse_depends($_->{value});
     }
     return $dl;
 }
 #   convert simple XML parser Bag into flat list
 sub swith ($$) {
     my ($bags,$name) = @_;
     my ($cond);
     my (@out);
     foreach $cond (keys %$bags) {
         foreach (@{$bags->{$cond}->{$name}}) {
             push @out, {
                 cond  => $cond,
                 value => $_
             };
         }
     }
     return \@out;
 }
 #   convert (conditional) XML/RDF Bag into flat list
 sub xwith ($) {
     my ($bags) = @_;
     my ($bag, $li, $el);
     my (@out);
     foreach $bag (@$bags) {
         foreach $li (@{$bag->{'rdf:bag'}}) {
             $el = $li->{'resource'} || $li->{'rdf:li'};
             foreach (@$el) {
                 push @out, {
                     cond   => $bag->{'cond'},
                     value  => $_
                 };
             }
         }
     }
     return \@out;
 }
 #   return node value from XML parser
 sub xel($) {
     my ($a) = @_;
     my ($l) = $a->[0];
     return '' if ref($l);
     return $l;
 }
 #   is the platform a good one?
 sub goodpf ($$) {
     my ($l, $p) = @_;
     return 1 if $l eq '';
     return ($l =~ m/(?:^|\s)\Q$p\E(?:\s|$)/);
 }
 #############################################################################
 ##
 ##  FUNCTIONS: HELPER FUNCTIONS FOR XML PARSING & DEPENDENCY PROCESSING
 ##
 #############################################################################
 #   parse option from RPM output
 #   < "%option with_foo bar"
 #   > $with{"with_foo"} = "bar"
 sub parse_options ($) {
     my ($l) = @_;
     $l = join("\n", @$l) if (ref($l));
     return {} if ($l !~ m/(--define|\%option\s+)/s);
     my $with = {};
     $l =~ s/--define\s*'(\S+)\s+(\S+?)'/$with->{$1} = $2, ''/sge;  # before openpkg-20021230
     $l =~ s/\%option\s+(\S+)\s+(\S+)/$with->{$1} = $2, ''/sge;     # after  openpkg-20021230
     return $with;
 }
 #   fetch targets of a name that satisfy a condition and sort by target
 #   version. Input is a hash of versions(?) on which the condition has
 #   to be true and which points to an array of records with package
 #   version information. Output is the list of version sorted package
 #   version information records.
 sub get_targets ($$) {
     my ($relmap, $cond) = @_;
     return (
         sort {
             vcmp(vs($a), vs($b));
         } map {
             @{$relmap->{$_}}
         } grep {
             $cond->($_);
         } keys %$relmap
    );
 }
 #############################################################################
 ##
 ##  FUNCTIONS: DEPENDENCY PROCESSING
 ##
 #############################################################################
 #   search environment for packages that match a pattern
 sub search_pattern ($$) {
     my ($pattern, $env) = @_;
     my (@todo);
     if (defined($pattern)) {
         #   explicitly given package pattern
         @todo = map {
             my ($p) = $_;
             my ($s, $iswildcard);
             $s = $1 if ($p =~ s/(,[^\s,]+)$//);
             if ($p =~ s/\*+$//) {
                 $p = '^'.quotemeta($p).'';
                 $iswildcard = 1;
             } else {
                 $p = '^'.quotemeta($p).'$';
             }
             map { "$_$s" }
                 grep { m/$p/ && !($iswildcard && exists($env->{exclude}->{$_})) }
                     keys %{$env->{repository}}
         } split(/\s+/, $pattern);
     } else {
         #   undefined pattern means "-a" option that selects
         #   all packages from repository that are installed
         #   and not explicitly excluded on command line
         @todo = grep {
             my ($n) = $_;
                (ref($env->{installed}->{$n}))
             && !exists($env->{exclude}->{$n})
             && grep { $_ ne '-' } keys %{$env->{installed}->{$n}}
         } keys(%{$env->{repository}});
     }
     return \@todo;
 }
 #   pull in OPTIONS for a package or an RPM file
 my $get_with_cache = {};
 sub get_with ($;$) {
     my ($t, $fn) = @_;
     my (@l, %with);
     my ($optmap, $opt);
     if ($t->{OPTIONS}) {
         $opt = $t->{OPTIONS};
     } else {
         if (defined($fn)) {
             @l = run($config->{"rpm"} . " -q --provides -p $fn");
         } else {
             if (not exists($get_with_cache->{-provides})) {
                 #   pre-cache the "provides" query for all(!) packages at once for speedup
                 my @c = run($config->{"rpm"} . " -qa --qf " .
                     '\'%{NAME}[ :::%{PROVIDENAME}:::%{PROVIDEFLAGS:depflags}:::%{PROVIDEVERSION}:::]\n\'');
                 $get_with_cache->{-provides} = {};
                 foreach my $c (@c) {
                     if ($c =~ m/^(\S+)(.*)$/s) {
                         my ($name, $provides) = ($1, $2);
                         while ($provides =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
                             $get_with_cache->{-provides}->{$name} = [] if (not exists($get_with_cache->{-provides}->{$name}));
                             push(@{$get_with_cache->{-provides}->{$name}}, "$1 $2 $3");
                         }
                     }
                 }
             }
             @l = $get_with_cache->{-provides}->{$t->{name}};
             if (not @l) {
                 #   (should not happen in practice, but anyway)
                 @l = run($config->{"rpm"} . " -q --provides $t->{name}");
                 $get_with_cache->{-provides}->{$t->{name}} = [ @l ];
             }
         }
         $opt = parse_provideslist(\@l);
         if (scalar(keys(%$opt)) == 0) {
             if (defined($fn)) {
                 @l = run($config->{"rpm"} . " -qi -p $fn");
             } else {
                 if (not exists($get_with_cache->{-infos})) {
                     #   pre-cache the "infos" query for all(!) packages at once for speedup
                     my @c = run($config->{"rpm"} . " -qi -a");
                     my $p = "";
                     $get_with_cache->{-infos} = {};
                     foreach my $c (@c) {
                         $p = $1 if ($c =~ m/^Name:\s+(\S+)/s);
                         $get_with_cache->{-infos}->{$p} = [] if (not exists($get_with_cache->{-infos}->{$p}));
                         push(@{$get_with_cache->{-infos}->{$p}}, $c);
                     }
                 }
                 @l = $get_with_cache->{-infos}->{$t->{name}};
                 if (not @l) {
                     #   (should not happen in practice, but anyway)
                     @l = run($config->{"rpm"} . " -qi $t->{name}");
                     $get_with_cache->{-infos}->{$t->{name}} = [ @l ];
                 }
             }
             $opt = parse_options(\@l);
         }
         $t->{OPTIONS} = $opt;
     }
     return $opt;
 }
 #   copy options from new to old
 #   where option already exists in old or option key
 #   matches regular expression
 sub override_options ($$$) {
     my ($old, $new, $reg) = @_;
     my ($k);
     foreach $k (keys(%$new)) {
         if ((exists($old->{$k}) && $old->{$k} ne $new->{$k}) || $k =~ m/^$reg$/) {
             $old->{$k} = $new->{$k};
         }
     }
 }
 #   filter package options
 sub filter_name_with ($$$) {
     my ($name, $with, $global) = @_;
     my (@keys);
     if ($global) {
         push(@keys, grep { !/::/ } keys %$with);
     }
     push(@keys, grep { m/::/ } keys %$with);
     return {
         map {
             my ($k) = $_;
               $k !~ m/::/ || $k =~ s/^\Q$name\E:://
             ? ( $k => $with->{$_} )
             : ( )
         } @keys
     };
 }
 #   filter out package relevant options
 sub name_with ($$) {
     filter_name_with($_[0], $_[1], 1);
 }
 #   filter out package specific options
 sub name_only_with ($$) {
     filter_name_with($_[0], $_[1], 0);
 }
 #   evaluate a condition attribute from an option set
 sub conditional ($$) {
     my ($cond, $with) = @_;
     my (@s, $res);
     return 1 if ($cond eq '' || !defined($with));
     foreach (split(/\s+/,$cond)) {
         if ($_ eq '+') {
             die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 2;
             my ($a) = pop(@s);
             my ($b) = pop(@s);
             push(@s, $a && $b);
         } elsif ($_ eq '|') {
             die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 2;
             my ($a) = pop(@s);
             my ($b) = pop(@s);
             push(@s, $a || $b);
         } elsif ($_ eq '!') {
             die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
             my ($a) = pop(@s);
             push(@s, !$a);
         } else {
             push(@s, ($with->{$_} eq 'yes') ? 1 : 0);
         }
     }
     die "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
     $res = pop(@s);
     die "openpkg:build:FATAL: stack not empty in: $cond\n" if scalar(@s) > 0;
     return $res;
 }
 #   retrieve conditional target attributes in map
 sub target_attribute ($$$;$) {
     my ($target, $env, $attr, $with) = @_;
     my ($optreg) = $env->{config}->{optreg};
     my ($name, @out);
     return if (not $target);
     $name = $target->{name};
     my ($mywith) = ($with ? $with : get_with($target));
     override_options($mywith, name_with($name, $env->{with}), $optreg);
     foreach (@{$target->{$attr}}) {
         next if (not conditional($_->{'cond'}, $mywith));
         push(@out, $_->{'value'});
     }
     return \@out;
 }
 #   see whether target is in map
 sub target_exists ($$) {
     my ($target, $map) = @_;
     my ($vmap) = $map->{$target->{name}};
     return if (not $vmap);
     return (
            !defined $target->{version}
         || defined $vmap->{vs($target)}
     );
 }
 #   see whether target has conflicts
 sub target_conflicts ($$) {
     my ($target, $env) = @_;
     return target_attribute($target, $env, 'conflicts');
 }
 #   retrieve build dependencies for target
 sub target_depends ($$) {
     my ($target, $env) = @_;
     return target_attribute($target, $env, 'depends');
 }
 #   retrieve runtime dependencies for target
 sub target_keeps ($$) {
     my ($target, $env) = @_;
     return target_attribute($target, $env, 'keeps');
 }
 #   retrieve source list for target
 sub target_source ($$) {
     my ($target, $env) = @_;
     return target_attribute($target, $env, 'source');
 }
 #   retrieve nosource list for target
 sub target_nosource ($$) {
     my ($target, $env) = @_;
     return target_attribute($target, $env, 'nosource');
 }
 #   check whether target conflicts against map
 sub target_has_conflicts ($$$) {
     my ($target, $map, $env) = @_;
     my ($conflicts, $t);
     $conflicts = target_conflicts($target, $env);
     foreach (@$conflicts) {
         my ($t) = find_target($_, $map, 0);
         return $t if $t;
     }
     return;
 }
 #   record target status
 sub target_setstatus ($$$) {
     my ($target, $status, $pri) = @_;
     if ($pri > $target->{STATUSPRI}) {
         $target->{STATUSPRI} = $pri;
         $target->{STATUS}    = $status;
     }
 }
 #   strip doubles from depend/keep lists
 #   and return a map name => depend/keep
 sub unique_map {
     my (%out);
     foreach (@_) {
         foreach (@$_) {
             $out{$_->{name}} = $_;
         }
     }
     return %out;
 }
 #   check whether installed package matches build options. If default
 #   = 1 then options which are not required must be identical to the
 #   DEFOPTS.
 sub target_suitable ($$$) {
     my ($target, $with, $default) = @_;
     my ($iwith, $dwith);
     my ($k, $v);
     if ($target->{GOAL}) {
         $with = name_with($target->{name}, $with);
     } else {
         $with = name_only_with($target->{name}, $with);
     }
     $iwith = $target->{OPTIONS};
     $dwith = $target->{DEFOPTS};
     while (($k,$v) = each(%$iwith)) {
         if (exists($with->{$k})) {
             return 0 if ($iwith->{$k} ne $with->{$k});
         } elsif ($default) {
             return 0 if ($iwith->{$k} ne $dwith->{$k});
         }
     }
     return 1;
 }
 #   determine whether target should be rebuild
 sub target_better ($$$) {
     my ($env, $target, $map) = @_;
     my ($vs) = vs($target);
     my ($vmap) = $map->{$target->{name}};
     #   rebuild if target isn't installed
     return 'new' unless $vmap;
     #   if "-e" then
     #   always update if installed version is different from repository
     if ($env->{exact} && !grep { vcmp($vs, $_) == 0; } keys(%$vmap)) {
         return 'exact';
     }
     #   if target is goal
     #   always update if installed version is older than repository
     if ($target->{GOAL} && !grep { vcmp($vs, $_) <= 0; } keys(%$vmap)) {
         return 'goal';
     }
     #   if -U then
     #   always update if installed version is older than repository
     if ($env->{upgrade} && !grep { vcmp($vs, $_) <= 0; } keys(%$vmap)) {
         return 'upgrade';
     }
     #   if -z/-Z then
     #   always update if installed version is equal or older than repository
     if ($env->{zero} && grep { vcmp($vs, $_) >= 0; } keys(%$vmap)) {
         return 'zero';
     }
     #   keep installed target
     return;
 }
 #   check if target record describes a source package
 sub is_source ($) {
     my ($t) = @_;
     return !(defined $t->{'prefix'});
 }
 #   there can be multiple sources for a target release
 sub chose_source ($$$$$) {
     my ($env, $name, $select, $vmap, $cond) = @_;
     my (@targ, @recs, @nrecs, $rec, %nam);
     #   resolve name into a list of versions
     #   for virtual targets this resolves to a list
     #   of real targets that provide the virtual target
     @targ = get_targets($vmap, sub { 1; });
     return unless @targ;
     #   find usable binary targets add all source targets
     @recs = (
         ( grep {
                !$env->{sourceonly}
             && !is_source($_)
             && $_->{'platform'} eq $env->{config}->{platform}
             && $_->{'prefix'} eq $env->{config}->{prefix}
         } get_targets($vmap, $cond) ),
         ( grep {
             is_source($_)
         } @targ )
     );
     return if (not @recs);
     #   limit list to exact matches if provided by "-e"
     if (defined($select)) {
         @recs = grep {
             vsn($_) =~ m/^\Q$select\E/
         } @recs;
     }
     #   try to resolve ambiguity against installed targets
     #   and targets previously selected
     if (scalar(@recs) > 1) {
         @nrecs = grep {
                $env->{built}->{$_->{name}}
             || $env->{installed}->{$_->{name}}
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   try to resolve ambiguity against hints
     if ($env->{hint}) {
         @nrecs = grep {
             exists($env->{hint}->{$_->{name}})
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   try to resolve ambiguity against targets that match
     #   the exact name
     if (scalar(@recs) > 1) {
         @nrecs = grep {
             $name eq $_->{name}
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   try to resolve ambiguity by preferring binaries
     if (scalar(@recs) > 1 && !$env->{sourceonly}) {
         @nrecs = grep {
             defined($_->{'platform'})
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   if we still have non-unique targets, complain
     if (scalar(@recs) > 1) {
         %nam = map { $_->{name} => 1 } @recs;
         if (scalar(keys(%nam)) > 1) {
             print "# ambigous sources for $name\n";
             my ($i) = 0;
             foreach (@recs) {
                 print "# $i: ".vsn($_)." = $_->{href}\n";
                 $i++;
             }
             return;
         }
     }
     #   prefer full-source packages
     if (scalar(@recs) > 1) {
         @nrecs = grep {
                ! $_->{nosource}
             || ! @{$_->{nosource}}
         } @recs;
         unless (@nrecs) {
             @nrecs = grep {
                 $_->{href} !~ m/\.nosrc.rpm$/
             } @recs;
         }
         @recs = @nrecs if (@nrecs);
     }
     #   nothing left -> exit
     return if (scalar(@recs) == 0);
     #   chose last (= max version) in list of targets
     $rec = $recs[-1];
     print "# source for $name is ".vsn($rec)."\n";
     return $rec;
 }
 #   locate target for a dependency
 sub dep2target ($$$) {
     my ($dep, $env, $source) = @_;
     my ($name, $op, @targ);
     my ($i, $r, $b, $cond, $version);
     my ($t, $tdef, $why);
     ($name, $op, $version) = ($dep->{name}, $dep->{op}, $dep->{val});
     $i = $env->{installed}->{$name};
     $r = $env->{repository}->{$name};
     $b = $env->{built}->{$name};
     return if (not ($i || $r || $b));
     if (!defined($op)) {
         $cond = sub { 1; };
     } elsif ($op eq 'geq') {
         $cond = sub { vcmp($_[0],$version) >= 0; };
     } elsif ($op eq 'leq') {
         $cond = sub { vcmp($_[0],$version) <= 0; };
     } elsif ($op eq 'gt') {
         $cond = sub { vcmp($_[0],$version) >  0; };
     } elsif ($op eq 'lt') {
         $cond = sub { vcmp($_[0],$version) <  0; };
     } elsif ($op eq 'equ') {
         $cond = sub { vcmp($_[0],$version) == 0; };
     } else {
         die "openpkg:build:FATAL: internal error in dep2target\n";
     }
     $tdef = undef;
     #   search installed target that matches requirement
     #   use it if we are not upgrading (no -U and no -z/-Z)
     if ($i && (@targ = get_targets($i, $cond))) {
         foreach $t (@targ) {
             get_with($t);
             if (target_suitable($t, $env->{with}, 0)) {
                 $tdef = $t;
                 if (not ($env->{upgrade} || $env->{zero} || $source)) {
                     return ($t, 1);
                 }
             }
         }
     }
     #   search target in current build list that matches requirement
     #   use it if it exists
     if ($b && (@targ = get_targets($b, $cond))) {
         $t = $targ[0];
         return ($t, 1);
     }
     #   search target in repository and install it, if it is newer than
     #   corresponding installed versions avoid repository packages that
     #   would install 'new' (i.e. are not an upgrade of an existing
     #   package)
     $t = chose_source($env, $name, undef, $r, $cond);
     if ($t) {
         if (!$tdef || (
             ($why = target_better($env, $t, $env->{installed})) &&
             $why ne 'new'
             ) || $source) {
             return ($t, 0);
         }
     }
     #   if nothing is suitable in repository then fall back to
     #   anything we already have installed but that we skipped
     #   above to look for upgrades.
     if ($tdef) {
         return ($tdef, 1);
     }
     return;
 }
 #   compute reverse dependency map
 sub get_revdep ($) {
     my ($env) = @_;
     my ($i) = $env->{'installed'};
     my ($r) = $env->{'repository'};
     my ($pkg, %dep, %dlist, %rev);
     my (@targ, $t, $t1, $t2, $with, $name, $vmap);
     my ($d, $k, %d, $old, %name, %pkg);
     print "# computing reverse dependencies\n";
     #   iterate over all installed packages
     foreach $pkg (keys(%$i)) {
         $vmap = $r->{$pkg};
         if (not $vmap) {
             print "# ATTENTION: $pkg has no upgrade path (installed package not found in repository)\n";
             next;
         }
         #   get forward dependencies from installed packages
         #   dep{a}{b} is true if b depends directly on a
         #   dlist{a}  is list of packages that depend on a
         @targ = get_targets($i->{$pkg}, sub { 1; });
         foreach $t (@targ) {
             $with = get_with($t);
             $d = target_attribute($t, $env, 'depends', $with);
             $k = target_attribute($t, $env, 'keeps', $with);
             next if (not (@$d || @$k));
             %d = unique_map($d,$k);
             #   resolve package
             if (not exists($pkg{$pkg})) {
                 ($t2, $old) = dep2target({ name => $pkg }, $env, 1);
                 $t2 = undef if ($old);
                 $pkg{$pkg} = $t2;
             }
             $t2 = $pkg{$pkg};
             next if (not $t2);
             foreach (keys(%d)) {
                 next if ($_ eq 'OpenPKG');
                 #   resolve target
                 unless (exists($name{$_})) {
                     ($t1, $old) = dep2target($d{$_}, $env, 0);
                     $name{$_} = ($t1 ? $t1->{name} : $_);
                 }
                 $name = $name{$_};
                 if (not $dep{$name}{$t->{name}}) {
                     $dep{$name}{$t->{name}} = 1;
                     push(@{$dlist{$name}}, $t2);
                 }
             }
         }
     }
     #   sort reverse dependencies
     foreach $pkg (keys(%dep)) {
         $rev{$pkg} = [
             sort {
                    $dep{$b->{name}}{$a->{name}}
                 || -$dep{$a->{name}}{$b->{name}}
                 || $a->{name} cmp $b->{name}
             } @{$dlist{$pkg}}
         ];
     }
     #   return hash of package reverse dependencies
     return \%rev;
 }
 #   build package dependencies
 #   (all input and output is passed in 'env' hash)
 sub build_deps ($$) {
     my ($pattern, $env) = @_;
     my ($todo, @list, $list, @out);
     #   determine all packages which match the pattern
     $todo = search_pattern($pattern, $env);
     #   unfold target names into all(!) real targets names
     @list =
     map {
         map {
             map {
                 $_->{name}
             } @$_
         } values(%{$env->{repository}->{$_}})
     } @$todo;
     #   also add target name
     push @list, @$todo;
     #   strip duplicate names
     @list = keys %{ { map { $_ => 1 } @list } };
     #   cache reverse dependencies
     if (not $env->{revdep}) {
         $env->{revdep} = get_revdep($env);
     }
     #   map targets into list of dependency names
     @list = map {
           $env->{revdep}->{$_}
         ? (@{$env->{revdep}->{$_}})
         : ()
     } @list;
     #   iterate over dependencies
     foreach (@list) {
         #   avoiding cycles
         next if ($env->{builddeps}->{$_->{name}});
         $env->{builddeps}->{$_->{name}} = 1;
         #   generate result
         push(@out, $_);
         #   generate result recursively
         $list = build_deps($_->{name}, $env); # RECURSION
         push(@out, @$list);
     }
     #   return final results
     return \@out;
 }
 #   report options that are not used for
 sub warn_about_options ($$$) {
     my ($target, $with, $c) = @_;
     my ($iwith) = $target->{OPTIONS};
     my ($k, $v);
     return if (not defined($iwith));
     $with = name_with($target->{name}, $with);
     while (($k,$v) = each %$with) {
         if (not ($k =~ m/^$c->{optreg}$/ || exists $iwith->{$k})) {
             print "# ATTENTION: $target->{name} ignores option '$k'\n";
         }
     }
 }
 #   find target in map
 sub find_target ($$$) {
     my ($name, $map, $pos) = @_;
     my ($vmap) = $map->{$name};
     my (@vs);
     return if (not $vmap);
     @vs = sort { vcmp($b,$a) } keys(%$vmap);
     return $vmap->{$vs[$pos]}->[-1];
 }
 #   add dependency as build option
 sub depend_option ($$$) {
     my ($target, $dep, $env) = @_;
     my ($with, $opt, $relmap, @t, $t);
     my ($pro) = depends2provides($dep);
     my ($conflict) = 0;
     return 1 if (not defined($pro->{with}));
     my ($val) = defined($pro->{version}) ? $pro->{version} : 'yes';
     $with = $env->{with};
     $opt  = $pro->{prefix}.'::'.$pro->{with};
     if (defined($with->{$opt}) && $with->{$opt} ne $val) {
         print "# ", vsn($target), " has conflicting requirement $opt = $with->{$opt} != $val\n";
         $conflict = 1;
     }
     $relmap = $env->{built}->{$pro->{prefix}};
     @t = get_targets($relmap, sub { 1; });
     foreach $t (@t) {
         $with = $t->{OPTIONS};
         $opt  = $pro->{with};
         if (defined($with->{$opt}) && $with->{$opt} ne $val) {
             print "# ", vsn($t), " has conflicting requirement $opt = $with->{$opt} != $val\n";
             $conflict = 1;
         }
     }
     return 0 if ($conflict);
     print "# ", vsn($target), " adds option $opt = $val\n";
     $with->{$opt} = $val;
     return 1;
 }
 #   remember fatal error
 sub pusherr ($$$) {
     my ($env, $target, $mess) = @_;
     print "# $mess\n";
     push(@{$env->{fatal}}, vsn($target).": $mess\n");
 }
 #   generate dependencies
 sub make_dep ($$$$$$$) {
     my ($who, $target, $depth, $env, $list, $blist, $clist) = @_;
     my ($d, $k, %d, %k, $t, $old);
     my (@deps, $conflict, $why);
     #   check whether target is already in list of to be build packages
     if (target_exists($target, $env->{built})) {
         print "# $target->{name} is already in list\n";
         return;
     }
     #   check whether target is in conflict with already installed package
     if ($t = target_has_conflicts($target, $env->{installed}, $env)) {
         target_setstatus($target, 'CONFLICT', 4);
         push(@$clist, $target);
         pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
         return;
     }
     #   check whether target is in conflict with to be build package
     if ($t = target_has_conflicts($target, $env->{built}, $env)) {
         target_setstatus($target, 'CONFLICT', 4);
         push(@$clist, $target);
         pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
         return;
     }
     #   see if a target is already installed and requires a rebuild
     if ($t = find_target($target->{name}, $env->{installed}, -1)) {
         if (exists($env->{exclude}->{$target->{name}})) {
             print "# excluding $target->{name} (no upgrade allowed)\n";
             return;
         }
         #   pull in options (for status report)
         if ($target->{REBUILD}) {
             target_setstatus($target, 'DEPEND', 1);
             print "# rebuilding $target->{name} (dependency)\n";
         } elsif ($env->{zero}) {
             target_setstatus($target, 'ZERO', 1);
             print "# rebuilding $target->{name} (zero)\n";
         } elsif (vs($target) ne vs($t)) {
             target_setstatus($target, 'UPDATE', 3);
             print "# rebuilding $target->{name} (update)\n";
         } elsif (!target_suitable($t, $env->{with}, 0)) {
             target_setstatus($target, 'MISMATCH', 2);
             print "# rebuilding $target->{name} (parameter mismatch)\n";
         } elsif ($env->{goals} && $target->{GOAL}) {
             target_setstatus($target, 'GOAL', 3);
             print "# rebuilding $target->{name} (goal)\n";
         } else {
             print "# $target->{name} is already installed\n";
             return;
         }
         #   use options from installed base
         override_options(get_with($target), get_with($t), $env->{config}->{optreg});
         #   remember this is a rebuild for a proxy package
         $target->{PROXY} = $t->{PROXY};
         $target->{REBUILD} = 1;
     } else {
         print "# creating $target->{name}\n";
         target_setstatus($target, 'ADD', 3);
     }
     if (exists($env->{exclude}->{$target->{name}})) {
         die "openpkg:build:FATAL: target ".vsn($target)." is forbidden\n";
     }
     #   mark this as a target before reverse dependencies trigger it again
     push(@{$env->{built}->{$target->{name}}->{vs($target)}}, $target);
     $target->{LIMBO} = 1;
     #   recurse over dependencies
     $d = target_depends($target, $env);
     $k = target_keeps($target, $env);
     if (@$d || @$k) {
         %d = unique_map($d, $k);
         %k = unique_map($k);
         @deps     = ();
         $conflict = 0;
         foreach (keys %d) {
             #   old index misses a OpenPKG provider in the index... skip it
             next if ($_ eq 'OpenPKG');
             ($t, $old) = dep2target($d{$_}, $env, 0);
             if ($t) {
                 if ($old) {
                     print "# $target->{name} uses ".vsn($t)." for $_\n";
                     if ($t->{LIMBO}) {
                         print "# ATTENTION: ".vsn($t)." is in LIMBO\n";
                     }
                     next;
                 }
                 if (not depend_option($t, $d{$_}, $env)) {
                     push(@$clist, $target);
                     pusherr($env, $target, "$target->{name} has conflicting requirement");
                     target_setstatus($target, 'UNDEF', 4);
                     $conflict = 1;
                     next;
                 }
                 if ($k{$_}) {
                     push(@$blist, $t);
                     print "# $target->{name} installs ".vsn($t)." for $_\n";
                 } else {
                     print "# $target->{name} requires ".vsn($t)." for $_\n";
                 }
                 push(@deps, $t);
             } else {
                 push(@$clist, $target);
                 pusherr($env, $target, "$target->{name} searches a frood called '$_'");
                 target_setstatus($target, 'UNDEF', 4);
                 $conflict = 1;
             }
         }
         if (not $conflict) {
             foreach $t (@deps) {
                 make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
             }
         }
     }
     print "# adding ".vsn($target)." to list\n";
     $target->{WHO} = $who;
     $target->{WHY} = $target->{STATUS};
     push(@$list, $target);
     #   remember new options
     override_options(get_with($target), name_with($target->{name}, $env->{with}), '');
     #   moan about non-source packages
     foreach (@{target_nosource($target, $env)}) {
         my ($p) = target_source($target, $env)->[$_];
         $p =~ s/.*\///;
         print "# ATTENTION: unpackaged source $_: $p\n";
     }
     #   cleanup limbo
     $target->{LIMBO} = 0;
     #   a dependency could not be resolved, don't bother with reverse
     #   dependencies for this target
     return if ($conflict);
     if (!$env->{quick} && $target->{name} ne 'openpkg' ) {
         if (not $env->{revdep}) {
             $env->{revdep} = get_revdep($env);
         }
         foreach $t (@{$env->{revdep}->{$target->{name}}}) {
             #   this is a rebuild, triggering further revdeps
             $t->{REBUILD} = 1;
             #   this is a rebuild, keep this installed
             push(@$blist, $t);
             print "# rebuilding reverse dependency ".vsn($t)."\n";
             make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
         }
     }
 }
 #   generate build lists for targets matched by pattern
 #   (all input and output is passed in 'env' hash)
 sub build_list ($$) {
     my ($pattern, $env) = @_;
     my (@goals, @targets, @keeps, @conflicts, @bonly, $t);
     my ($name, $select, $r, $i);
     my ($todo, %keep);
     #   determine all packages which match the pattern
     $todo = search_pattern($pattern, $env);
     #   chose sources for goals from repository
     foreach $name (@$todo) {
         $select = undef;
         $select = $1 if ($name =~ s/,([^\s,]+)$//);
         $t = undef;
         #   keeping installed packages for goals is ugly
         #   - we currently do not support installed source RPMs
         #   - source RPMs might already have expired from repository
         #   consequence:
         #   - goals are always upgraded to repository versions
         #if (not $env->{upgrade}) {
         #    $i = $env->{installed}->{$name};
         #    $t = chose_source($env, $name, $select, $i, sub { 1; });
         #}
         if (not $t) {
             $r = $env->{repository}->{$name};
             $t = chose_source($env, $name, $select, $r, sub { 1; });
         }
         if ($t) {
             warn_about_options($t, $env->{with}, $env->{config});
             $t->{GOAL} = 1;
             push @goals, $t;
         } else {
             #   error
             if ($env->{status}) {
                 print "# dropping goal '$name'\n";
             } else {
                 die "openpkg:build:FATAL: cannot find source for '$name'\n";
             }
         }
     }
     return if (not @goals);
     #   recurse over dependencies
     @targets = ();
     @keeps   = @goals;
     foreach $t (@goals) {
         print "# recursing over dependencies for ".vsn($t)."\n";
         make_dep(undef, $t, 0, $env, \@targets, \@keeps, \@conflicts);
     }
     #   determine "binary only" packages which should be not kept
     #   as they were not installed and are used temporarily only.
     %keep = map { $_ => 1 } @keeps;
     @bonly = reverse grep {
         !$keep{$_} && !$env->{installed}->{$_->{name}}
     } @targets;
     #   return results
     return (\@targets, \@bonly, \@conflicts);
 }
 #############################################################################
 ##
 ##  FUNCTIONS: RESULT PRINTING
 ##
 #############################################################################
 #   determine execution command
 sub cmd ($$) {
     my ($w,$s) = @_;
     if (!defined($w)) {
         return $s;
     } elsif ($w =~ m/^-(.*)/) {
         return "$1 \"$s\"";
     } else {
         return "$w $s";
     }
 }
 sub priv  ($) { cmd($opt_P, $_[0]); }
 sub npriv ($) { cmd($opt_N, $_[0]); }
 #   execute a command
 my $run_cache = {};
 sub run ($) {
     my $cmd = cmd($opt_N, $_[0]);
     my $out = $run_cache->{$cmd};
     if (not defined($out)) {
         my @out = `$cmd`;
         $out = [ @out ];
         $run_cache->{$cmd} = $out;
     }
     return (wantarray ? @{$out} : join(//, @{$out}));
 }
 #   print dependency list
 sub print_deps ($) {
     my ($list) = @_;
     print join("\n", sort map { vsn($_) } @$list), "\n";
 }
 #   print dependency map
 sub print_map ($$$$$) {
     my ($installed, $repository, $list, $bonly, $clist) = @_;
     my (%dep);
     foreach (@$bonly) {
         $_->{status} = 'TEMP';
     }
     foreach (reverse(@$list)) {
         printf("%-35s %-8s %s\n",
             $_->{WHO} ? vsn($_->{WHO}) : "GOAL",
             $_->{WHY} ? $_->{WHY} : '???',
             vsn($_)
         );
     }
 }
 #   instead of printing a command list, print a status map
 #   that shows all packages and how the build process would
 #   change their status
 sub print_status ($$$$$) {
     my ($installed, $repository, $list, $bonly, $clist) = @_;
     my (%bonly) = map { $_ => 1 } @$bonly;
     my (%map, $n, @names, $t);
     my ($old, $tag, $new);
     #   augment map with additional information
     #   about conflicting and binary only (temporary) packages
     foreach (@$list, @$clist) {
         next if (not $_->{release} =~ m/\S/);
         $map{$_->{name}} = {
             rel    => "$_->{version}-$_->{release}",
             status => $_->{STATUS}
         };
     }
     foreach (@$bonly) {
         next if (not $_->{release} =~ m/\S/);
         $map{$_->{name}} = {
             rel    => "$_->{version}-$_->{release}",
             status => 'TEMP'
         };
     }
     #   augment map with additional information
     #   about up-to-date and new packages
     @names = keys(%map);
     foreach $n (keys(%$installed)) {
         next if ($n =~ m/::/);
         next if (exists($map{$n}));
         next if (not (grep { $_ ne '' } keys(%{$installed->{$n}})));
         $map{$n}->{'status'} = 'OK';
         push(@names, $n);
     }
     foreach $n (keys(%$repository)) {
         next if ($n =~ m/::/);
         next if (exists($map{$n}));
         next if (not (grep { $_ ne '' } keys(%{$repository->{$n}})));
         $t = find_target($n, $repository, 0);
         $map{$n}->{'status'} = 'NEW';
         $map{$n}->{'rel'}    = vs($t);
         push(@names, $n);
     }
     #   generate status output
     foreach $n (sort(@names)) {
         $old = join(',',
             map { "$n-$_" }
             sort
             grep { $_ ne '-' }
             keys(%{$installed->{$n}})
         );
         $old = $n if ($old eq '');
         $tag = $map{$n}->{status};
         $new = defined($map{$n}->{rel}) ? " $n-$map{$n}->{rel}" : '';
         printf("%-35s %-8s%s\n", $old, $tag, $new);
     }
 }
 #   compute path to source RPM from rpm config and target data
 sub target2srcrpm ($$) {
     my ($target, $c) = @_;
     return $c->{srcrpmdir}.'/'.$target->{name}.'-'.$target->{version}.'-'.$target->{release}.'.src.rpm';
 }
 #   compute path to binary RPM from rpm config and target data
 sub target2rpm ($$) {
     my ($target, $c) = @_;
     my ($tmpl) = $c->{template};
     my ($popt) = $target->{PROXY} ? '+PROXY' : '';
     $tmpl =~ s/%{NAME}/$target->{name}/;
     $tmpl =~ s/%{VERSION}/$target->{version}/;
     $tmpl =~ s/%{RELEASE}/$target->{release}$popt/;
     return $c->{rpmdir}.'/'.$tmpl;
 }
 #   merge parameters from installed package
 #   with new parameter set and global parameters
 #   from configuration
 #   then map the result to --define command line arguments
 #   suitable for rpm
 sub make_defines ($$$$) {
     my ($old, $new, $def, $c) = @_;
     my ($with);
     $old = {} unless $old;
     $def = {} unless $def;
     #   override old parameters with new parameters
     #   drop new parameters that do not exist in old set
     $old = { %$old };
     override_options($old, $new, $c->{optreg});
     #   convert parameters to --define command line options
     #   skip parameter templates from index
     #   skip parameters that are identical to defaults
     $with = join(' ',
         map { "--define '$_ $old->{$_}'" }
         sort grep {
             $old->{$_} =~ m/\S/ &&
             $old->{$_} !~ m/^%/ &&
             $old->{$_} ne $def->{$_}
         } keys %$old
     );
     $with = ' '.$with if ($with ne '');
     return $with;
 }
 #   compute new target based on old target augmented with options from
 #   a binary RPM file
 sub binary_target ($$) {
     my ($t, $fn) = @_;
     my (%target) = %$t;
     #   pull in options from binary RPM file
     delete $target{'OPTIONS'};
     get_with(\%target, $fn);
     return \%target;
 }
 #   return path to master package for a proxy package
 sub find_proxy ($$) {
     my ($t, $bpkg) = @_;
     my (@l) = run($config->{"rpm"} . " -ql $t->{name}");
     my ($link) = (grep { $_ =~ m/\/\.prefix-$t->{name}$/ } @l)[0];
     return if (not defined($link));
     chomp $link;
     my ($prefix) = readlink($link);
     return if (not defined($prefix));
     $bpkg =~ s/.*\///;
     $bpkg =~ s/\+PROXY(\.[^-]+-[^-]+)-[^-]+\.rpm$/$1-*.rpm/;
     return (glob("$prefix/RPM/PKG/$bpkg"))[0];
 }
 #   indent text to form a block
 sub indent ($) {
     my ($txt) = @_;
     $txt =~ s/^/    /gm;
     return $txt;
 }
 #   print commands from package build list
 #   c      -> configuration to derive paths from
 #   uncond -> always do the --rebuild
 #   with   -> parameter set passed to build tool
 #   ignore -> generate script that does not stop on error
 #   usebin -> build-time check to skip rebuild when binary exists
 #   allbin -> usebin also for goals
 sub print_list1 ($$$$$$$) {
     my ($list, $c, $uncond, $with, $ignore, $usebin, $allbin) = @_;
     my ($pkg, $spkg, $bpkg, $uvhpkg, $ppkg);
     my ($opt);
     my ($cmd1, $cmd2, $mark);
     my ($cmd3, $srcpkg);
     $mark = '::::';
     my $err;
     if ($ignore) { $err = "|| true" } else { $err = "|| exit \$?" };
     foreach (@$list) {
         $pkg = $_->{name};
         $spkg = $_->{href};
         unless ($spkg =~ m/\S/) {
             die "openpkg:build:FATAL: internal error, ",vsn($_)," without source URL\n";
         }
         $bpkg = target2rpm($_, $c); $uvhpkg = $bpkg;
         $srcpkg = target2srcrpm($_, $c);
         $cmd3 = '';
         #   rebuild binary package IF
         #   'unconditional' option
         #   OR target is tagged as rebuilding
         #   OR there is no binary package
         #   OR dependency check found that installed package is not suitable
         #   OR existing binary package doesn't satisfy wanted options
         $cmd1 = undef;
         if (   $uncond
             || !-f $bpkg
             || !target_suitable(binary_target($_, $bpkg), $with, 1)) {
             $opt = make_defines($_->{OPTIONS}, $with,
                                 $_->{DEFOPTS}, $c);
             #   proxy packages are rebuilt from their maste
             #   hierachy
             #   someone preferred a binary from the repository
             #   just copy it to the local store
             if ($_->{PROXY}) {
                 $ppkg = find_proxy($_,$bpkg) or
                 die "openpkg:build:FATAL: proxy package ",vsn($_)," does not exist\n";
                 #   rpm doesn't support additional parameters to the
                 #   mkproxy script
                 #   $cmd1 = npriv($config->{"mkp"} . " $ppkg -- -o $bpkg");
                 $cmd1 = "( cd $c->{rpmdir} && ".
                         npriv($config->{"mkp"} . " $ppkg").
                         " )";
             } elsif (defined $_->{prefix}) {
                 $cmd1 = '';
                 if ($spkg =~ m|^\.?/|) {
                     $uvhpkg = $spkg;
                 }
                 else {
                     $cmd1 .= npriv($config->{"curl"} . " -# -o $bpkg $spkg $err\n");
                     $cmd3 = npriv("rm -f $bpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
                 }
             } else {
                 $cmd1 = '';
                 if ($spkg =~ m|^\.?/|) {
                     $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $spkg $err\n");
                 }
                 else {
                     $cmd1 .= "if test ! -f $srcpkg; then\n";
                     $cmd1 .= indent(npriv($config->{"curl"} . " -# -o $srcpkg $spkg $err\n"));
                     $cmd1 .= "fi\n";
                     $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $srcpkg $err\n");
                     $cmd1 .= npriv("rm -f $srcpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
                 }
             }
         }
         #   wrap build command with build-time check for existing
         #   binary target
         if (defined($cmd1) && ($allbin || ($usebin && !$_->{GOAL}))) {
             $cmd1 = "if test ! -f $uvhpkg; then\n".indent($cmd1)."fi\n";
         }
         #   if package exist force rpm to copy over new files
         #   better than erasing everything and losing configuration
         #   files
         $opt = ($_->{REBUILD} || ($allbin || ($usebin && !$_->{GOAL}))) ? ' --force' : '';
         $cmd2 = '';
         $cmd2 .= priv($config->{"rpm"} . "$opt -Uvh $uvhpkg $err\n");
         if ($allbin || ($usebin && !$_->{GOAL})) {
             $cmd2 = "if test \".`".$config->{"rpm"}." -q --qf '\%{SIGMD5}' $pkg`\" != \".`".$config->{"rpm"}." -qp --qf '\%{SIGMD5}' $uvhpkg`\"; then\n".indent($cmd2)."fi\n";
         }
         $cmd2 = $cmd1.$cmd2 if ($cmd1);
         $cmd2 = $cmd2.$cmd3 if ($cmd3);
         print "echo $mark $spkg $mark\n".$cmd2."echo $mark $spkg = \$? $mark\n";
     }
 }
 #   print commands for the temporary package list
 #   temporary packages are only used for building other packages
 #   and are removed when everything is done
 sub print_list2 ($$) {
     my ($list, $c) = @_;
     my ($pkg);
     foreach (@$list) {
         $pkg = "$_->{name}-$_->{version}-$_->{release}";
         print priv($config->{"rpm"} . " -e $pkg\n");
     }
 }

OpenPKG Specs / annotate

openpkg/build.pl@c10fb90893b9 (annotated)

openpkg/build.pl