TEST INSTANCE of openSUSE Build Service

Overview Repositories Revisions Requests Users Attributes Meta

File Build.obscpio of Package build

07070100000000000081a400000000000000000000000163e504b900000759000000000000000000000000000000000000001200000000Build/Appimage.pm################################################################
#
# Copyright (c) 2017 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Appimage;

use strict;
use Build::Deb;
use Build::Rpm;

eval { require YAML::XS; $YAML::XS::LoadBlessed = 0; };
*YAML::XS::LoadFile = sub {die("YAML::XS is not available\n")} unless defined &YAML::XS::LoadFile;

sub parse {
  my ($cf, $fn) = @_;

my $yml;
  eval { $yml = YAML::XS::LoadFile($fn); };
  return {'error' => "Failed to parse yml file"} unless $yml;

my $ret = {};
  $ret->{'name'} = $yml->{'app'};
  $ret->{'version'} = $yml->{'version'} || "0";

my @packdeps;
  if ($yml->{'ingredients'}) {
    for my $pkg (@{$yml->{'ingredients'}->{'packages'} || {}}) {
      push @packdeps, $pkg;
    }
  }
  if ($yml->{'build'} && $yml->{'build'}->{'packages'}) {
    for my $pkg (@{$yml->{'build'}->{'packages'}}) {
      push @packdeps, $pkg;
    }
  }
  $ret->{'deps'} = \@packdeps;

my @sources;
  if ($yml->{'build'} && $yml->{'build'}->{'files'}) {
    for my $source (@{$yml->{'build'}->{'files'}}) {
      push @sources, $source;
    }
  }
  $ret->{'sources'} = \@sources;

return $ret;
}

1;
07070100000001000081a400000000000000000000000163e504b900002b62000000000000000000000000000000000000000e00000000Build/Arch.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Arch;

use strict;
use Digest::MD5;

eval { require Archive::Tar; };
*Archive::Tar::new = sub {die("Archive::Tar is not available\n")} unless defined &Archive::Tar::new;

# Archlinux support, based on the GSoC work of Nikolay Rysev <mad.f3ka@gmail.com>

# parse a PKGBUILD file

sub expandvars {
  my ($str, $vars) = @_;
  $str =~ s/\$([a-zA-Z0-9_]+|\{([^\}]+)\})/join(' ', @{$vars->{$2 || $1} || []})/ge;
  return $str;
}

sub quote {
  my ($str, $q, $vars) = @_;
  $str = expandvars($str, $vars) if $q ne "'" && $str =~ /\$/;
  $str =~ s/([ \t\"\'\$])/sprintf("%%%02X", ord($1))/ge;
  return $str;
}

sub unquotesplit {
  my ($str, $vars) = @_;
  $str =~ s/%/%25/g;
  $str =~ s/^[ \t]+//;
  while ($str =~ /([\"\'])/) {
    my $q = $1;
    last unless $str =~ s/$q(.*?)$q/quote($1, $q, $vars)/e;
  }
  $str = expandvars($str, $vars) if $str =~ /\$/;
  my @args = split(/[ \t]+/, $str);
  for (@args) {
    s/%([a-fA-F0-9]{2})/chr(hex($1))/ge
  }
  return @args;
}

sub get_assets {
  my ($vars, $asuf) = @_;
  my @digests;
  for my $digesttype ('sha512', 'sha256', 'sha1', 'md5') {
    @digests = map {$_ eq 'SKIP' ? $_ : "$digesttype:$_"} @{$vars->{"${digesttype}sums$asuf"} || []};
    last if @digests;
  }
  # work around bug in source parser
  my @sources;
  for (@{$vars->{"source$asuf"} || []}) {
    push @sources, $_;
    splice(@sources, -1, 1, $1, "$1.sig") if /(.*)\{,\.sig\}$/;
  }
  my @assets;
  for my $s (@sources) {
    my $digest = shift @digests;
    next unless $s =~ /^https?:\/\/.*\/([^\.\/][^\/]+)$/s;
    my $asset = { 'url' => $s };
    $asset->{'digest'} = $digest if $digest && $digest ne 'SKIP';
    push @assets, $asset;
  }
  return @assets;
}

sub parse {
  my ($config, $pkgbuild) = @_;
  my $ret;
  local *PKG;
  if (!open(PKG, '<', $pkgbuild)) {
    $ret->{'error'} = "$pkgbuild: $!";
    return $ret;
  }
  my %vars;
  my @ifs;
  while (<PKG>) {
    chomp;
    next if /^\s*$/;
    next if /^\s*#/;
    s/^\s+//;
    if (/^(el)?if\s+(?:(?:test|\[)\s+(-n|-z)\s+)?(.*?)\s*\]?\s*;\s*then\s*$/) {
      if ($1) {
        $ifs[-1] += 1;
        next if $ifs[-1] != 1;
        pop @ifs;
      }
      my $flag = $2 || '-n';
      my $t = join('', unquotesplit($3, \%vars));
      $t = $t eq '' ? 'true' : '' if $flag eq '-z';
      push @ifs, $t ne '' ? 1 : 0;
      next;
    }
    if (@ifs) {
      if (/^fi\s*$/) {
        pop @ifs;
        next;
      } elsif (/^else\s*$/) {
        $ifs[-1] += 1;
        next;
      }
      next if grep {$_ != 1} @ifs;
    }
    last unless /^([a-zA-Z0-9_]*)(\+?)=($?)(.*?)$/;
    my $var = $1;
    my $app = $2;
    my $val = $4;
    if ($3) {
      while ($val !~ s/$\s*(?:#.*)?$//s) {
	my $nextline = <PKG>;
	last unless defined $nextline;
	chomp $nextline;
	$val .= ' ' . $nextline;
      }
    }
    if ($app) {
      push @{$vars{$var}}, unquotesplit($val, \%vars);
    } else {
      $vars{$var} = [ unquotesplit($val, \%vars) ];
    }
  }
  close PKG;
  $ret->{'name'} = $vars{'pkgname'}->[0] if $vars{'pkgname'};
  $ret->{'version'} = $vars{'pkgver'}->[0] if $vars{'pkgver'};
  $ret->{'deps'} = [];
  push @{$ret->{'deps'}}, @{$vars{$_} || []} for qw{makedepends checkdepends depends};
  # get arch from macros
  my ($arch) = Build::gettargetarchos($config);
  # map to arch linux name and add arch dependent
  $arch = 'i686' if $arch =~ /^i[345]86$/;
  push @{$ret->{'deps'}}, @{$vars{"${_}_$arch"} || []} for qw{makedepends checkdepends depends};
  # Maintain architecture-specific sources for officially supported architectures
  for my $asuf ('', '_i686', '_x86_64') {
    $ret->{"source$asuf"} = $vars{"source$asuf"} if $vars{"source$asuf"};
  }
  # find remote assets
  for my $asuf ('', "_$arch") {
    next unless @{$vars{"source$asuf"} || []};
    my @assets = get_assets(\%vars, $asuf);
    push @{$ret->{'remoteassets'}}, @assets if @assets;
  }
  return $ret;
}

sub islzma {
  my ($fn) = @_;
  local *F;
  return 0 unless open(F, '<', $fn);
  my $h;
  return 0 unless read(F, $h, 5) == 5;
  close F;
  return $h eq "\3757zXZ";
}

sub iszstd {
  my ($fn) = @_;
  local *F;
  return 0 unless open(F, '<', $fn);
  my $h;
  return 0 unless read(F, $h, 4) == 4;
  close F;
  return $h eq "(\265\057\375";
}

sub lzmadec {
  my ($fn) = @_;
  my $nh;
  my $pid = open($nh, '-|');
  return undef unless defined $pid;
  if (!$pid) {
    $SIG{'PIPE'} = 'DEFAULT';
    exec('xzdec', '-dc', $fn);
    die("xzdec: $!\n");
  }
  return $nh;
}

sub zstddec {
  my ($fn) = @_;
  my $nh;
  my $pid = open($nh, '-|');
  return undef unless defined $pid;
  if (!$pid) {
    $SIG{'PIPE'} = 'DEFAULT';
    exec('zstdcat', $fn);
    die("zstdcat $!\n");
  }
  return $nh;
}

sub queryvars {
  my ($handle) = @_;

if (ref($handle)) {
    die("arch pkg query not implemented for file handles\n");
  }
  if ($handle =~ /\.zst$/ || iszstd($handle)) {
    $handle = zstddec($handle);
  } elsif ($handle =~ /\.xz$/ || islzma($handle)) {
    $handle = lzmadec($handle);
  }
  my $tar = Archive::Tar->new;
  my @read = $tar->read($handle, 1, {'filter' => '^\.PKGINFO$', 'limit' => 1});
  die("$handle: not an arch package file\n") unless @read ==  1;
  my $pkginfo = $read[0]->get_content;
  die("$handle: not an arch package file\n") unless $pkginfo;
  my %vars;
  $vars{'_pkginfo'} = $pkginfo;
  for my $l (split('\n', $pkginfo)) {
    next unless $l =~ /^(.*?) = (.*)$/;
    push @{$vars{$1}}, $2;
  }
  return \%vars;
}

sub queryfiles {
  my ($handle) = @_;
  if (ref($handle)) {
    die("arch pkg query not implemented for file handles\n");
  }
  if ($handle =~ /\.zst$/ || iszstd($handle)) {
    $handle = zstddec($handle);
  } elsif ($handle =~ /\.xz$/ || islzma($handle)) {
    $handle = lzmadec($handle);
  }
  my @files;
  my $tar = Archive::Tar->new;
  # we use filter_cb here so that Archive::Tar skips the file contents
  $tar->read($handle, 1, {'filter_cb' => sub {
    my ($entry) = @_;
    push @files, $entry->name unless $entry->is_longlink || (@files && $files[-1] eq $entry->name);
    return 0;
  }});
  shift @files if @files && $files[0] eq '.PKGINFO';
  return \@files;
}

sub query {
  my ($handle, %opts) = @_;
  my $vars = queryvars($handle);
  my $ret = {};
  $ret->{'name'} = $vars->{'pkgname'}->[0] if $vars->{'pkgname'};
  $ret->{'hdrmd5'} = Digest::MD5::md5_hex($vars->{'_pkginfo'});
  $ret->{'provides'} = $vars->{'provides'} || [];
  $ret->{'requires'} = $vars->{'depend'} || [];
  if ($vars->{'pkgname'} && $opts{'addselfprovides'}) {
    my $selfprovides = $vars->{'pkgname'}->[0];
    $selfprovides .= "=$vars->{'pkgver'}->[0]" if $vars->{'pkgver'};
    push @{$ret->{'provides'}}, $selfprovides unless @{$ret->{'provides'} || []} && $ret->{'provides'}->[-1] eq $selfprovides;
  }
  if ($opts{'evra'}) {
    if ($vars->{'pkgver'}) {
      my $evr = $vars->{'pkgver'}->[0];
      if ($evr =~ /^([0-9]+):(.*)$/) {
	$ret->{'epoch'} = $1;
	$evr = $2;
      }
      $ret->{'version'} = $evr;
      if ($evr =~ /^(.*)-(.*?)$/) {
	$ret->{'version'} = $1;
	$ret->{'release'} = $2;
      }
    }
    $ret->{'arch'} = $vars->{'arch'}->[0] if $vars->{'arch'};
  }
  if ($opts{'description'}) {
    $ret->{'description'} = $vars->{'pkgdesc'}->[0] if $vars->{'pkgdesc'};
  }
  if ($opts{'conflicts'}) {
    $ret->{'conflicts'} = $vars->{'conflict'} if $vars->{'conflict'};
    $ret->{'obsoletes'} = $vars->{'replaces'} if $vars->{'replaces'};
  }
  if ($opts{'weakdeps'}) {
    my @suggests = @{$vars->{'optdepend'} || []};
    s/:.*// for @suggests;
    $ret->{'suggests'} = \@suggests if @suggests;
  }
  # arch packages don't seem to have a source :(
  # fake it so that the package isn't confused with a src package
  $ret->{'source'} = $ret->{'name'} if defined $ret->{'name'};
  $ret->{'buildtime'} = $vars->{'builddate'}->[0] if $opts{'buildtime'} && $vars->{'builddate'};
  return $ret;
}

sub queryhdrmd5 {
  my ($handle) = @_;
  if (ref($handle)) {
    die("arch pkg query not implemented for file handles\n");
  }
  if ($handle =~ /\.zst$/ || iszstd($handle)) {
    $handle = zstddec($handle);
  } elsif ($handle =~ /\.xz$/ || islzma($handle)) {
    $handle = lzmadec($handle);
  }
  my $tar = Archive::Tar->new;
  my @read = $tar->read($handle, 1, {'filter' => '^\.PKGINFO$', 'limit' => 1});
  die("$handle: not an arch package file\n") unless @read ==  1;
  my $pkginfo = $read[0]->get_content;
  die("$handle: not an arch package file\n") unless $pkginfo;
  return Digest::MD5::md5_hex($pkginfo);
}

sub parserepodata {
  my ($d, $data) = @_;
  $d ||= {};
  $data =~ s/^\n+//s;
  my @parts = split(/\n\n+/s, $data);
  for my $part (@parts) {
    my @p = split("\n", $part);
    my $p = shift @p;
    if ($p eq '%NAME%') {
      $d->{'name'} = $p[0];
    } elsif ($p eq '%VERSION%') {
      $d->{'version'} = $p[0];
    } elsif ($p eq '%ARCH%') {
      $d->{'arch'} = $p[0];
    } elsif ($p eq '%BUILDDATE%') {
      $d->{'buildtime'} = $p[0];
    } elsif ($p eq '%FILENAME%') {
      $d->{'filename'} = $p[0];
    } elsif ($p eq '%PROVIDES%') {
      push @{$d->{'provides'}}, @p;
    } elsif ($p eq '%DEPENDS%') {
      push @{$d->{'requires'}}, @p;
    } elsif ($p eq '%OPTDEPENDS%') {
      push @{$d->{'suggests'}}, @p;
    } elsif ($p eq '%CONFLICTS%') {
      push @{$d->{'conflicts'}}, @p;
    } elsif ($p eq '%REPLACES%') {
      push @{$d->{'obsoletes'}}, @p;
    } elsif ($p eq '%MD5SUM%') {
      $d->{'checksum_md5'} = $p[0];
    } elsif ($p eq '%SHA256SUM%') {
      $d->{'checksum_sha256'} = $p[0];
    }
  }
  return $d;
}

sub queryinstalled {
  my ($root, %opts) = @_;

$root = '' if !defined($root) || $root eq '/';
  local *D;
  local *F;
  opendir(D, "$root/var/lib/pacman/local") || return [];
  my @pn = sort(grep {!/^\./} readdir(D));
  closedir(D);
  my @pkgs;
  for my $pn (@pn) {
    next unless open(F, '<', "$root/var/lib/pacman/local/$pn/desc");
    my $data = '';
    1 while sysread(F, $data, 8192, length($data));
    close F;
    my $d = parserepodata(undef, $data);
    next unless defined $d->{'name'};
    my $q = {};
    for (qw{name arch buildtime version}) {
      $q->{$_} = $d->{$_} if defined $d->{$_};
    }
    $q->{'epoch'} = $1 if $q->{'version'} =~ s/^(\d+)://s;
    $q->{'release'} = $1 if $q->{'version'} =~ s/-([^-]*)$//s;
    push @pkgs, $q;
  }
  return \@pkgs;
}

1;
07070100000002000081a400000000000000000000000163e504b900000d87000000000000000000000000000000000000001200000000Build/Archrepo.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Archrepo;

use strict;
use Build::Arch;

eval { require Archive::Tar; };
if (!defined &Archive::Tar::iter) {
  *Archive::Tar::iter = sub {
    my ($class, $filename) = @_;
    die("Archive::Tar is not available\n") unless defined &Archive::Tar::new;
    Archive::Tar->new();
    my $handle = $class->_get_handle($filename, 1, 'rb') or return undef;
    my @data;
    return sub {
      return shift(@data) if !$handle || @data; 
      my $files = $class->_read_tar($handle, { limit => 1 });
      @data = @$files if (ref($files) || '') eq 'ARRAY';
      undef $handle unless @data;
      return shift @data;
    };
  };
}

sub addpkg {
  my ($res, $data, $options) = @_;
  return unless defined $data->{'version'};
  if ($options->{'addselfprovides'}) {
    my $selfprovides = $data->{'name'};
    $selfprovides .= "=$data->{'version'}" if defined $data->{'version'};
    push @{$data->{'provides'}}, $selfprovides unless @{$data->{'provides'} || []} && $data->{'provides'}->[-1] eq $selfprovides;
  }
  if ($options->{'normalizedeps'}) {
    # our normalized dependencies have spaces around the op
    for my $dep (qw {provides requires conflicts obsoletes suggests}) {
      next unless $data->{$dep};
      s/ ?([<=>]+) ?/ $1 / for @{$data->{$dep}};
    }
  }
  if (defined($data->{'version'})) {
    # split version into evr
    $data->{'epoch'} = $1 if $data->{'version'} =~ s/^(\d+)://s;
    $data->{'release'} = $1 if $data->{'version'} =~ s/-([^-]*)$//s;
  }
  $data->{'location'} = delete($data->{'filename'}) if exists $data->{'filename'};
  if ($options->{'withchecksum'}) {
    for (qw {md5 sha1 sha256}) {
      my $c = delete($data->{"checksum_$_"});
      $data->{'checksum'} = "$_:$c" if $c;
    }     
  } else {
    delete $data->{"checksum_$_"} for qw {md5 sha1 sha256};
  }
  if (ref($res) eq 'CODE') {
    $res->($data);
  } else {
    push @$res, $data;
  }
}

sub parse {
  my ($in, $res, %options) = @_;
  $res ||= [];
  die("Build::Archrepo::parse needs a filename\n") if ref($in);
  die("$in: $!\n") unless -e $in;
  my $repodb = Archive::Tar->iter($in, 1);
  die("$in is not a tar archive\n") unless $repodb;
  my $e;
  my $lastfn = '';
  my $d;
  while ($e = $repodb->()) {
    next unless $e->type() == Archive::Tar::Constant::FILE();
    my $fn = $e->name();
    next unless $fn =~ s/\/(?:depends|desc|files)$//s;
    if ($lastfn ne $fn) {
      addpkg($res, $d, \%options) if $d->{'name'};
      $d = {};
      $lastfn = $fn;
    }
    Build::Arch::parserepodata($d, $e->get_content());
  }
  addpkg($res, $d, \%options) if $d->{'name'};
  return $res;
}

1;
07070100000003000081a400000000000000000000000163e504b900000645000000000000000000000000000000000000001000000000Build/Collax.pm#
# Copyright 2015  Zarafa B.V. and its licensors
#
# This program is free software; you can redistribute it and/or modify it under
# the terms of the GNU General Public License as published by the Free Software
# Foundation; either version 2 or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
# details.
#
package Build::Collax;

use strict;

sub parse {
	my($buildconf, $fn) = @_;
	my @bscript;

if (ref($fn) eq "ARRAY") {
		@bscript = @$fn;
		$fn = undef;
	} elsif (ref($fn) ne "") {
		die "Unhandled ref type in collax";
	} else {
		local *FH;
		if (!open(FH, "<", $fn)) {
			return {"error" => "$fn: $!"};
		}
		@bscript = <FH>;
		chomp(@bscript);
		close(FH);
	}

my $ret = {"deps" => []};
	for (my $i = 0; $i <= $#bscript; ++$i) {
		next unless $bscript[$i] =~ m{^\w+=};
		my $key = lc(substr($&, 0, -1));
		my $value = $';
		if ($value =~ m{^([\'\"])}) {
			$value = substr($value, 1);
			while ($value !~ m{[\'\"]}) {
				my @cut = splice(@bscript, $i + 1, 1);
				$value .= $cut[0];
			}
			$value =~ s{[\'\"]}{}s;
			$value =~ s{\n}{ }gs;
		}
		if ($key eq "package") {
			$ret->{"name"} = $value;
		} elsif ($key eq "version") {
			$ret->{$key} = $value;
		} elsif ($key eq "builddepends" || $key eq "extradepends") {
			$value =~ s{^\s+}{}gs;
			$value =~ s{\s+$}{}gs;
			$value =~ s{,}{ }gs;
			push(@{$ret->{"deps"}}, split(/\s+/, $value));
		}
	}
	return $ret;
}

1;
07070100000004000081a400000000000000000000000163e504b9000038e5000000000000000000000000000000000000000d00000000Build/Deb.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Deb;

use strict;
use Digest::MD5;

my $have_zlib;
my $have_rawlzma;
eval {
  require Compress::Zlib;
  $have_zlib = 1;
};
eval {
  require Compress::Raw::Lzma;
  $have_rawlzma = 1;
};

my %obs2debian = (
  "i486"    => "i386",
  "i586"    => "i386",
  "i686"    => "i386",
  "ppc"     => "powerpc",
  "ppc64le" => "ppc64el",
  "x86_64"  => "amd64",
  "armv4l"  => "armel",
  "armv5l"  => "armel",
  "armv6l"  => "armel",
  "armv7el" => "armel",
  "armv7l"  => "armhf",
  "armv7hl" => "armhf",
  "aarch64" => "arm64",
);

sub basearch {
  my ($arch) = @_;
  return 'all' if !defined($arch) || $arch eq 'noarch';
  return $obs2debian{$arch} || $arch;
}

sub obsarch {
  my ($arch) = @_;
  my @obs = grep {$obs2debian{$_} eq $arch} sort keys %obs2debian;
  return @obs if @obs;
  return $arch;
}

sub parse {
  my ($bconf, $fn) = @_;

# get arch and os from macros and map to debian names
  my ($arch, $os) = Build::gettargetarchos($bconf);
  $os = 'linux' unless defined $os;
  $arch = basearch($arch);

my @control;
  if (ref($fn) eq 'ARRAY') {
    @control = @$fn;
  } else {
    local *F;
    return { 'error' => "$fn: $!" } unless open(F, '<', $fn);
    @control = <F>;
    close F;
    chomp @control;
  }
  splice(@control, 0, 3) if @control > 3 && $control[0] =~ /^-----BEGIN/;
  my $name;
  my $version;
  my @deps;
  my @exclarch;
  while (@control) {
    my $c = shift @control;
    last if $c eq '';   # new paragraph
    my ($tag, $data) = split(':', $c, 2);
    next unless defined $data;
    $tag = uc($tag);
    while (@control && $control[0] =~ /^\s/) {
      $data .= "\n".substr(shift @control, 1);
    }
    $data =~ s/^\s+//s;
    $data =~ s/\s+$//s;
    if ($tag eq 'VERSION') {
      $version = $data;
      $version =~ s/-[^-]+$//;
    } elsif ($tag eq 'ARCHITECTURE') {
      my @archs = split('\s+', $data);
      map { s/\Q$os\E-//; s/any-// } @archs;
      next if grep { $_ eq "any" || $_ eq "all" } @archs;
      @exclarch = map { obsarch($_) } @archs;
      # unify
      my %exclarch = map {$_ => 1} @exclarch;
      @exclarch = sort keys %exclarch;
    } elsif ($tag eq 'SOURCE') {
      $name = $data;
    } elsif ($tag eq 'BUILD-DEPENDS' || $tag eq 'BUILD-CONFLICTS' || $tag eq 'BUILD-IGNORE' ||
        $tag eq 'BUILD-DEPENDS-INDEP' || $tag eq 'BUILD-DEPENDS-ARCH' || $tag eq 'BUILD-CONFLICTS-ARCH' ) {
      my @d = split(/\s*,\s*/, $data);
      for my $d (@d) {
        my @alts = split('\s*\|\s*', $d);
        my @needed;
        for my $c (@alts) {
          if ($c =~ /\s+<[^>]+>$/) {
            my @build_profiles;  # Empty for now
            my $bad = 1;
            while ($c =~ s/\s+<([^>]+)>$//) {
              next if (!$bad);
              my $list_valid = 1;
              for my $term (split(/\s+/, $1)) {
                my $isneg = ($term =~ s/^\!//);
                my $profile_match = grep(/^$term$/, @build_profiles);
                if (( $profile_match &&  $isneg) ||
                    (!$profile_match && !$isneg)) {
                  $list_valid = 0;
                  last;
                }
              }
              $bad = 0 if ($list_valid);
            }
            next if ($bad);
          }
          if ($c =~ /^(.*?)\s*\[(.*)\]$/) {
            $c = $1;
            my $isneg = 0;
            my $bad;
            for my $q (split('[\s,]', $2)) {
              $isneg = 1 if $q =~ s/^\!//;
              $bad = 1 if !defined($bad) && !$isneg;
              if ($isneg) {
                if ($q eq $arch || $q eq 'any' || $q eq "$os-$arch" || $q eq "$os-any" || $q eq "any-$arch") {
                  $bad = 1;
                  last;
                }
              } elsif ($q eq $arch || $q eq 'any' || $q eq "$os-$arch" || $q eq "$os-any" || $q eq "any-$arch") {
                $bad = 0;
              }
            }
            next if ($bad);
          }
          $c =~ s/^([^:\s]*):(any|native)(.*)$/$1$3/;
          push @needed, $c;
        }
        next unless @needed;
        $d = join(' | ', @needed);
	$d =~ s/ $([^$]*)\)/ $1/g;
	$d =~ s/>>/>/g;
	$d =~ s/<</</g;
	if ($tag eq 'BUILD-DEPENDS' || $tag eq 'BUILD-DEPENDS-INDEP' || $tag eq 'BUILD-DEPENDS-ARCH') {
	  push @deps, $d;
	} else {
	  push @deps, "-$d";
	}
      }
    }
  }
  my $ret = {};
  $ret->{'name'} = $name;
  $ret->{'version'} = $version;
  $ret->{'deps'} = \@deps;
  $ret->{'exclarch'} = \@exclarch if @exclarch;
  return $ret;
}

sub uncompress_rawlzma {
  my ($in) = @_;
  return undef unless defined($in) && $in ne '';
  my $out = '';
  my ($lz, $status) = Compress::Raw::Lzma::AutoDecoder->new('ConsumeInput' => 1, 'AppendOutput' => 1);
  return undef unless $lz;
  while (1) {
    $status = $lz->code($in, $out);
    return $out if $status == Compress::Raw::Lzma::LZMA_STREAM_END();
    return undef if $status != Compress::Raw::Lzma::LZMA_OK();
  }
}

sub uncompress {
  my ($data, $tool) = @_;
  return $data if $tool eq 'cat';
  return Compress::Zlib::memGunzip($data) if $have_zlib && $tool eq 'gunzip';
  return uncompress_rawlzma($data) if $have_rawlzma && $tool eq 'unxz';
  local (*TMP, *TMP2);
  open(TMP, "+>", undef) or die("could not open tmpfile\n");
  syswrite TMP, $data;
  my $pid = open(TMP2, "-|");
  die("fork: $!\n") unless defined $pid;
  if (!$pid) {
    open(STDIN, "<&TMP");
    seek(STDIN, 0, 0);    # these two lines are a workaround for a perl bug mixing up FD
    sysseek(STDIN, 0, 0);
    exec($tool);
    die("$tool: $!\n");
  }
  close(TMP);
  $data = '';
  1 while sysread(TMP2, $data, 1024, length($data)) > 0;
  if (!close(TMP2)) {
    warn("$tool error: $?\n");
    return undef;
  }
  return $data;
}

sub control2res {
  my ($control) = @_;
  my %res;
  my @control = split("\n", $control);
  while (@control) {
    my $c = shift @control;
    last if $c eq '';   # new paragraph
    my ($tag, $data) = split(':', $c, 2);
    next unless defined $data;
    $tag = uc($tag);
    while (@control && $control[0] =~ /^\s/) {
      $data .= "\n".substr(shift @control, 1);
    }
    $data =~ s/^\s+//s;
    $data =~ s/\s+$//s;
    $res{$tag} = $data;
  }
  return %res;
}

sub debq {
  my ($fn) = @_;

local *DEBF;
  if (ref($fn) eq 'GLOB') {
      *DEBF = *$fn;
  } elsif (!open(DEBF, '<', $fn)) {
    warn("$fn: $!\n");
    return ();
  }
  my $data = '';
  sysread(DEBF, $data, 4096);
  if (length($data) < 8+60) {
    warn("$fn: not a debian package - header too short\n");
    close DEBF unless ref $fn;
    return ();
  }
  if (substr($data, 0, 8+16) ne "!<arch>\ndebian-binary   " &&
      substr($data, 0, 8+16) ne "!<arch>\ndebian-binary/  ") {
    close DEBF unless ref $fn;
    return ();
  }
  my $len = substr($data, 8+48, 10);
  $len += $len & 1;
  if (length($data) < 8+60+$len+60) {
    my $r = 8+60+$len+60 - length($data);
    $r -= length($data);
    if ((sysread(DEBF, $data, $r < 4096 ? 4096 : $r, length($data)) || 0) < $r) {
      warn("$fn: unexpected EOF\n");
      close DEBF unless ref $fn;
      return ();
    }
  }
  $data = substr($data, 8 + 60 + $len);
  my $controlname = substr($data, 0, 16);
  my $decompressor;
  if ($controlname eq 'control.tar.gz  ' || $controlname eq 'control.tar.gz/ ') {
    $decompressor = 'gunzip';
  } elsif ($controlname eq 'control.tar.xz  ' || $controlname eq 'control.tar.xz/ ') {
    $decompressor = 'unxz';
  } elsif ($controlname eq 'control.tar.zst ' || $controlname eq 'control.tar.zst/') {
    $decompressor = 'unzstd';
  } elsif ($controlname eq 'control.tar     ' || $controlname eq 'control.tar/    ') {
    $decompressor = 'cat';
  } else {
    warn("$fn: control.tar is not second ar entry\n");
    close DEBF unless ref $fn;
    return ();
  }
  $len = substr($data, 48, 10);
  if (length($data) < 60+$len) {
    my $r = 60+$len - length($data);
    if ((sysread(DEBF, $data, $r, length($data)) || 0) < $r) {
      warn("$fn: unexpected EOF\n");
      close DEBF unless ref $fn;
      return ();
    }
  }
  close DEBF unless ref($fn);
  $data = substr($data, 60, $len);
  my $controlmd5 = Digest::MD5::md5_hex($data);	# our header signature
  $data = uncompress($data, $decompressor);
  if (!$data) {
    warn("$fn: corrupt control.tar file\n");
    return ();
  }
  my $control;
  while (length($data) >= 512) {
    my $n = substr($data, 0, 100);
    $n =~ s/\0.*//s;
    my $len = oct('00'.substr($data, 124,12));
    my $blen = ($len + 1023) & ~511;
    if (length($data) < $blen) {
      warn("$fn: corrupt control.tar file\n");
      return ();
    }
    if ($n eq './control' || $n eq "control") {
      $control = substr($data, 512, $len);
      last;
    }
    $data = substr($data, $blen);
  }
  my %res = control2res($control);
  $res{'CONTROL_MD5'} = $controlmd5;
  return %res;
}

sub query {
  my ($handle, %opts) = @_;

my %res = debq($handle);
  return undef unless %res;
  my $name = $res{'PACKAGE'};
  my @provides = split(',\s*', $res{'PROVIDES'} || '');
  if ($opts{'addselfprovides'}) {
    push @provides, "$name (= $res{'VERSION'})";
  }
  my @depends = split(',\s*', $res{'DEPENDS'} || '');
  push @depends, split(',\s*', $res{'PRE-DEPENDS'} || '');
  my $data = {
    name => $name,
    hdrmd5 => $res{'CONTROL_MD5'},
    provides => \@provides,
    requires => \@depends,
  };
  my $src = $name;
  if ($res{'SOURCE'}) {
    $src = $res{'SOURCE'};
    $data->{'sourcedep'} = $src;
    $src =~ s/\s.*$//;
  }
  $data->{'source'} = $src if $src ne '';
  if ($opts{'conflicts'}) {
    my @conflicts = split(',\s*', $res{'CONFLICTS'} || '');
    push @conflicts, split(',\s*', $res{'BREAKS'} || '');
    $data->{'conflicts'} = \@conflicts if @conflicts;
  }
  if ($opts{'weakdeps'}) {
    for my $dep ('SUGGESTS', 'RECOMMENDS', 'ENHANCES') {
      $data->{lc($dep)} = [ split(',\s*', $res{$dep} || '') ] if defined $res{$dep};
    }
  }
  if ($opts{'evra'}) {
    $res{'VERSION'} =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
    $data->{'epoch'} = $1 if defined $1;
    $data->{'version'} = $2;
    $data->{'release'} = $3 if defined $3;
    $data->{'arch'} = $res{'ARCHITECTURE'};
    $data->{'multiarch'} = $res{'MULTI-ARCH'} if $res{'MULTI-ARCH'};
  }
  if ($opts{'description'}) {
    $data->{'description'} = $res{'DESCRIPTION'};
  }
  if ($opts{'normalizedeps'}) {
    for my $dep (qw{provides requires conflicts suggests enhances recommends}) {
      next unless $data->{$dep};
      for (@{$data->{$dep}}) {
        s/ $([^$]*)\)/ $1/g;
        s/<</</g;
        s/>>/>/g;
      }
    }
  }
  return $data;
}

sub queryhdrmd5 {
  my ($bin) = @_;

local *F;
  open(F, '<', $bin) || die("$bin: $!\n");
  my $data = '';
  sysread(F, $data, 4096);
  if (length($data) < 8+60) {
    warn("$bin: not a debian package - header too short\n");
    close F;
    return undef;
  }
  if (substr($data, 0, 8+16) ne "!<arch>\ndebian-binary   " &&
      substr($data, 0, 8+16) ne "!<arch>\ndebian-binary/  ") {
    warn("$bin: not a debian package - no \"debian-binary\" entry\n");
    close F;
    return undef;
  }
  my $len = substr($data, 8+48, 10);
  $len += $len & 1;
  if (length($data) < 8+60+$len+60) {
    my $r = 8+60+$len+60 - length($data);
    $r -= length($data);
    if ((sysread(F, $data, $r < 4096 ? 4096 : $r, length($data)) || 0) < $r) {
      warn("$bin: unexpected EOF\n");
      close F;
      return undef;
    }
  }
  $data = substr($data, 8 + 60 + $len);
  my $controlname = substr($data, 0, 16);
  if ($controlname ne 'control.tar.gz  ' && $controlname ne 'control.tar.gz/ ' &&
      $controlname ne 'control.tar.xz  ' && $controlname ne 'control.tar.xz/ ' &&
      $controlname ne 'control.tar.zst ' && $controlname ne 'control.tar.zst/' &&
      $controlname ne 'control.tar     ' && $controlname ne 'control.tar/    ') {
    warn("$bin: control.tar is not second ar entry\n");
    close F;
    return undef;
  }
  $len = substr($data, 48, 10);
  if (length($data) < 60+$len) {
    my $r = 60+$len - length($data);
    if ((sysread(F, $data, $r, length($data)) || 0) < $r) {
      warn("$bin: unexpected EOF\n");
      close F;
      return undef;
    }
  }
  close F;
  $data = substr($data, 60, $len);
  return Digest::MD5::md5_hex($data);
}

sub verscmp_part {
  my ($s1, $s2) = @_;
  return 0 if $s1 eq $s2;
  $s1 =~ s/([0-9]+)/substr("00000000000000000000000000000000$1", -32, 32)/ge;
  $s2 =~ s/([0-9]+)/substr("00000000000000000000000000000000$1", -32, 32)/ge;
  $s1 .= "\0";
  $s2 .= "\0";
  $s1 =~ tr[\176\000-\037\060-\071\101-\132\141-\172\040-\057\072-\100\133-\140\173-\175][\000-\176];
  $s2 =~ tr[\176\000-\037\060-\071\101-\132\141-\172\040-\057\072-\100\133-\140\173-\175][\000-\176];
  return $s1 cmp $s2;
}

sub verscmp {
  my ($s1, $s2) = @_;
  my ($e1, $v1, $r1) = $s1 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
  $e1 = 0 unless defined $e1;
  my ($e2, $v2, $r2) = $s2 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
  $e2 = 0 unless defined $e2;
  if ($e1 ne $e2) {
    my $r = verscmp_part($e1, $e2);
    return $r if $r;
  }
  my $r = verscmp_part($v1, $v2);
  return $r if $r;
  $r1 = '' unless defined $r1;
  $r2 = '' unless defined $r2;
  return verscmp_part($r1, $r2);
}

sub queryinstalled {
  my ($root, %opts) = @_;

$root = '' if !defined($root) || $root eq '/';
  my @pkgs;
  local *F;
  if (open(F, '<', "$root/var/lib/dpkg/status")) {
    my $ctrl = '';
    while(<F>) {
      if ($_ eq "\n") {
	my %res = control2res($ctrl);
	if (defined($res{'PACKAGE'})) {
	  my $data = {'name' => $res{'PACKAGE'}};
	  $res{'VERSION'} =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
	  $data->{'epoch'} = $1 if defined $1;
	  $data->{'version'} = $2;
	  $data->{'release'} = $3 if defined $3;
	  $data->{'arch'} = $res{'ARCHITECTURE'};
	  push @pkgs, $data;
	}
        $ctrl = '';
	next;
      }
      $ctrl .= $_;
    }
    close F;
  }
  return \@pkgs;
}

1;
07070100000005000081a400000000000000000000000163e504b900001489000000000000000000000000000000000000001100000000Build/Debrepo.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Debrepo;

use strict;

sub addpkg {
  my ($res, $data, $options) = @_;
  return unless defined $data->{'version'};
  my $selfprovides;
  $selfprovides = "= $data->{'version'}" if $options->{'addselfprovides'};
  # split version into evr
  $data->{'epoch'} = $1 if $data->{'version'} =~ s/^(\d+)://s;
  $data->{'release'} = $1 if $data->{'version'} =~ s/-([^-]*)$//s;
  for my $d (qw{provides requires conflicts recommends suggests enhances breaks prerequires}) {
    next unless $data->{$d};
    if ($options->{'normalizedeps'}) {
      $data->{$d} =~ s/$([^$]*)\)/$1/g;
      $data->{$d} =~ s/<</</g;
      $data->{$d} =~ s/>>/>/g;
    }
    $data->{$d} = [ split(/\s*,\s*/, $data->{$d}) ];
  }
  push @{$data->{'requires'}}, @{$data->{'prerequires'}} if $data->{'prerequires'};
  delete $data->{'prerequires'};
  push @{$data->{'conflicts'}}, @{$data->{'breaks'}} if $data->{'breaks'};
  delete $data->{'breaks'};
  if (defined($selfprovides)) {
    $selfprovides = "($selfprovides)" unless $options->{'normalizedeps'};
    $selfprovides = "$data->{'name'} $selfprovides";
    push @{$data->{'provides'}}, $selfprovides  unless @{$data->{'provides'} || []} && $data->{'provides'}->[-1] eq $selfprovides;
  }
  if ($options->{'withchecksum'}) {
    for (qw {md5 sha1 sha256}) {
      my $c = delete($data->{"checksum_$_"});
      $data->{'checksum'} = "$_:$c" if $c;
    }
  }
  $data->{'sourcedep'} = $data->{'source'} if $data->{'source'};
  $data->{'source'} =~ s/\s.*// if $data->{'source'};
  if (ref($res) eq 'CODE') {
    $res->($data);
  } else {
    push @$res, $data;
  }
}

my %tmap = (
  'package' => 'name',
  'version' => 'version',
  'architecture' => 'arch',
  'provides' => 'provides',
  'depends' => 'requires',
  'pre-depends' => 'prerequires',
  'conflicts' => 'conflicts',
  'breaks' => 'breaks',
  'recommends' => 'recommends',
  'suggests' => 'suggests',
  'enhances' => 'enhances',
  'filename' => 'location',
  'source' => 'source',
  'multi-arch' => 'multiarch',
);

my %tmap_checksums = (
  'md5sum' => 'checksum_md5',
  'sha1'   => 'checksum_sha1',
  'sha256' => 'checksum_sha256',
);

sub parse {
  my ($in, $res, %options) = @_;
  $res ||= [];
  my $fd;
  if (ref($in)) {
    $fd = $in;
  } else {
    if ($in =~ /\.gz$/) {
      open($fd, '-|', "gzip", "-dc", $in) || die("$in: $!\n");
    } else {
      open($fd, '<', $in) || die("$in: $!\n");
    }
  }
  my $pkg = {};
  my $tag;
  my %ltmap = %tmap;
  %ltmap = (%ltmap, %tmap_checksums) if $options{'withchecksum'};
  while (<$fd>) {
    chomp;
    if ($_ eq '') {
      addpkg($res, $pkg, \%options) if %$pkg;
      $pkg = {};
      next;
    }
    if (/^\s/) {
      next unless $tag;
      $pkg->{$tag} .= "\n".substr($_, 1);
      next;
    }
    my $data;
    ($tag, $data) = split(':', $_, 2);
    next unless defined $data;
    $tag = $ltmap{lc($tag)};
    next unless $tag;
    $data =~ s/^\s*//;
    $pkg->{$tag} = $data;
  }
  addpkg($res, $pkg, \%options) if %$pkg;
  if (!ref($in)) {
    close($fd) || die("close $in: $!\n");
  }
  return $res;
}

sub urldecode {
  my ($str, $iscgi) = @_;
  $str =~ tr/+/ / if $iscgi;
  $str =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/sge;
  return $str;
}

sub parserepourl {
  my ($url) = @_;
  my @components;
  my $baseurl;
  if ($url =~ /\?/) {
    my ($base, $query) = split(/\?/, $url, 2);
    if ("&$query" =~ /\&dist=/) {
      my $dist;
      for my $querypart (split('&', $query)) {
        my ($k, $v) = split('=', $querypart, 2);
        $k = urldecode($k, 1);
        $v = urldecode($v, 1);
        $dist = $v if $k eq 'dist';
        push @components, split(/[,+]/, $v) if $k eq 'component';
      }
      $baseurl = $base;
      $baseurl .= '/' unless $baseurl =~ /\/$/;
      $url = "${baseurl}dists/${dist}/";
      push @components, 'main' unless @components;
    }
  }
  if (@components) {
    ;   # all done above
  } elsif ($url =~ /^(.*\/)\.(\/.*)?$/) {
    # flat repo
    $baseurl = $1;
    @components = ('.');
    $url = defined($2) ? "$1$2" : $1;
    $url .= '/' unless $url =~ /\/$/;
  } else {
    if ($url =~ /([^\/]+)$/) {
      @components = split(/[,+]/, $1);
      $url =~ s/([^\/]+)$//;
    }
    push @components, 'main' unless @components;
    $url .= '/' unless $url =~ /\/$/;
    $baseurl = $url;
    $url =~ s/([^\/]+\/)$/dists\/$1/;
    $baseurl =~ s/([^\/]+\/)$//;
  }
  return $baseurl, $url, \@components;
}

1;
07070100000006000081a400000000000000000000000163e504b900003a3d000000000000000000000000000000000000001000000000Build/Docker.pm################################################################
#
# Copyright (c) 2017 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Docker;

use Build::SimpleXML;	# to parse the annotation
use Build::SimpleJSON;

use strict;

sub unify {
  my %h = map {$_ => 1} @_;
  return grep(delete($h{$_}), @_);
}

sub gettargetarch {
  my ($config) = @_;
  my $arch = 'noarch';
  for (@{$config->{'macros'} || []}) {
    $arch = $1 if /^%define _target_cpu (\S+)/;
  }
  return $arch;
}

sub slurp {
  my ($fn) = @_;
  local *F;
  return undef unless open(F, '<', $fn);
  local $/ = undef;	# Perl slurp mode
  my $content = <F>;
  close F;
  return $content;
}

sub expandvar_cplx {
  my ($cplx, $vars) = @_;
  if ($cplx =~ /^\!([a-zA-Z0-9_]+)/) {
    return [] unless @{$vars->{$1} || []};
    my $n = $vars->{$1}->[0];
    return $vars->{$n} || [];
  }
  return [] unless $cplx =~ /^([^\}:]+):([-+])([^}]*)$/s;
  my ($n, $m, $v) = ($1, $2, $3);
  $v = expandvars($v, $vars) if $v =~ /\$/;
  my $o = join(' ', @{$vars->{$n} || []});
  return $o ne '' ? $vars->{$n} : [ $v ] if $m eq '-';
  return $o ne '' ? [ $v ] : [] if $m eq '+';
  return [];
}

sub expandvars {
  my ($str, $vars) = @_;
  $str =~ s/\$([a-zA-Z0-9_]+)|\$\{([^\}:\!]+)\}|\$\{([^}]+)\}/join(' ', @{$3 ? expandvar_cplx($3, $vars) : $vars->{$2 || $1} || []})/ge;
  return $str;
}

sub quote {
  my ($str, $q, $vars) = @_;
  $str = expandvars($str, $vars) if $vars && $q ne "'" && $str =~ /\$/;
  $str =~ s/([ \t\"\'\$])/sprintf("%%%02X", ord($1))/ge;
  return $str;
}

sub addrepo {
  my ($ret, $url, $prio) = @_;

unshift @{$ret->{'imagerepos'}}, { 'url' => $url };
  $ret->{'imagerepos'}->[0]->{'priority'} = $prio if defined $prio;
  if (defined($Build::Kiwi::urlmapper) && !$Build::Kiwi::urlmapper) {
    unshift @{$ret->{'path'}}, { %{$ret->{'imagerepos'}->[0]} };
    return 1;
  }
  if ($Build::Kiwi::urlmapper) {
    my $prp = $Build::Kiwi::urlmapper->($url);
    if (!$prp) {
      $ret->{'error'} = "cannot map '$url' to obs";
      return undef;
    }
    my ($projid, $repoid) = split('/', $prp, 2);
    unshift @{$ret->{'path'}}, {'project' => $projid, 'repository' => $repoid};
    $ret->{'path'}->[0]->{'priority'} = $prio if defined $prio;
    return 1;
  } else {
    # this is just for testing purposes...
    $url =~ s/^\/+$//;
    $url =~ s/:\//:/g;
    my @url = split('/', $url);
    unshift @{$ret->{'path'}}, {'project' => $url[-2], 'repository' => $url[-1]} if @url >= 2;
    $ret->{'path'}->[0]->{'priority'} = $prio if defined $prio;
    return 1;
  }
}

sub cmd_zypper {
  my ($ret, @args) = @_;
  # skip global options
  while (@args && $args[0] =~ /^-/) {
    shift @args if $args[0] eq '-R' || $args[0] eq '--root' || $args[0] eq '--installroot';
    shift @args;
  }
  return unless @args;
  if ($args[0] eq 'in' || $args[0] eq 'install') {
    shift @args;
    while (@args && $args[0] =~ /^-/) {
      shift @args if $args[0] =~ /^--(?:from|repo|type)$/ || $args[0] =~ /^-[tr]$/;
      shift @args;
    }
    my @deps = grep {/^[a-zA-Z_0-9]/} @args;
    s/^([^<=>]+)([<=>]+)/$1 $2 / for @deps;
    push @{$ret->{'deps'}}, @deps;
  } elsif ($args[0] eq 'ar' || $args[0] eq 'addrepo') {
    my $prio;
    shift @args;
    while (@args && $args[0] =~ /^-/) {
      if ($args[0] eq '-p' || $args[0] eq '--priority') {
	$prio = 99 - $args[1];
	splice(@args, 0, 2);
	next;
      }
      shift @args if $args[0] =~ /^--(?:repo|type)$/ || $args[0] =~ /^-[rt]$/;
      shift @args;
    }
    if (@args) {
      my $path = $args[0];
      $path =~ s/\/[^\/]*\.repo$//;
      addrepo($ret, $path, $prio);
    }
  }
}

sub cmd_obs_pkg_mgr {
  my ($ret, @args) = @_;
  return unless @args;
  if ($args[0] eq 'add_repo') {
    shift @args;
    addrepo($ret, $args[0]) if @args;
  } elsif ($args[0] eq 'install') {
    shift @args;
    push @{$ret->{'deps'}}, @args;
  }
}

sub cmd_dnf {
  my ($ret, @args) = @_;
  # skip global options
  shift @args while @args && $args[0] =~ /^-/;
  return unless @args;
  if ($args[0] eq 'in' || $args[0] eq 'install') {
    shift @args;
    while (@args && $args[0] =~ /^-/) {
      shift @args;
    }
    push @{$ret->{'deps'}}, grep {/^[a-zA-Z_0-9]/} @args;
  }
}

sub cmd_apt_get {
  my ($ret, @args) = @_;
  shift @args while @args && $args[0] =~ /^-/;
  return unless @args;
  if ($args[0] eq 'install') {
    shift @args;
    push @{$ret->{'deps'}}, grep {/^[a-zA-Z_0-9]/} @args;
  }
}

sub cmd_curl {
  my ($ret, @args) = @_;
  my @urls;
  while (@args) {
    my $arg = shift @args;
    if ($arg eq '--url') {
      $arg = shift @args;
      push @urls, $arg if $arg =~ /^https?:\/\//;
    } elsif ($arg =~ /^-/) {
      shift @args if $arg eq '-d' || $arg =~ /^--data/ || $arg eq '-F' || $arg =~ /^--form/ || $arg eq '-m' || $arg =~ /^--max/ || $arg eq '-o' || $arg eq '--output' || $arg =~ /^--retry/ || $arg eq '-u' || $arg eq '--user' || $arg eq '-A' || $arg eq '--user-agent' || $arg eq '-H' || $arg eq '--header';
    } else {
      push @urls, $arg if $arg =~ /^https?:\/\//;
    }
  }
  for my $url (@urls) {
    my $asset = { 'url' => $url, 'type' => 'webcache' };
    push @{$ret->{'remoteassets'}}, $asset;
  }
}

sub parse {
  my ($cf, $fn) = @_;

my $unorderedrepos;
  my $useobsrepositories;
  my $nosquash;
  my $dockerfile_data;
  my $remoteasset;
  if (ref($fn) eq 'SCALAR') {
    $dockerfile_data = $$fn;
  } else {
    $dockerfile_data = slurp($fn);
    return { 'error' => 'could not open Dockerfile' } unless defined $dockerfile_data;
  }
  my @lines = split(/\r?\n/, $dockerfile_data);

my $ret = {
    'deps' => [],
    'path' => [],
    'imagerepos' => [],
  };

my %build_vars;
  if ($cf->{'buildflags:dockerarg'}) {
    for (@{$cf->{'buildflags'} || []}) {
      $build_vars{$1} = [ $2 ] if /^dockerarg:(.*?)=(.*)$/s;
    }
  }

my $excludedline;
  my $vars = {};
  my $vars_env = {};
  my $vars_meta = {};
  my %as_container;
  my $from_seen;

my @requiredarch;
  my @badarch;
  my @containerrepos;

while (@lines) {
    my $line = shift @lines;
    $line =~ s/^\s+//;
    if ($line =~ /^#/) {
      if ($line =~ /^#!BuildTag:\s*(.*?)$/) {
	my @tags = split(' ', $1);
	push @{$ret->{'containertags'}}, @tags if @tags;
      }
      if ($line =~ /^#!BuildName:\s*(\S+)\s*$/) {
	$ret->{'name'} = $1;
      }
      if ($line =~ /^#!BuildVersion:\s*(\S+)\s*$/) {
	$ret->{'version'} = $1;
      }
      if ($line =~ /^#!UnorderedRepos\s*$/) {
        $unorderedrepos = 1;
      }
      if ($line =~ /^#!UseOBSRepositories\s*$/) {
        $useobsrepositories = 1;
      }
      if ($line =~ /^#!NoSquash\s*$/) {
        $nosquash = 1;
      }
      if ($line =~ /^#!Milestone:\s*(\S+)\s*$/) {
	$ret->{'milestone'} = $1;
      }
      if ($line =~ /^#!ExcludeArch:\s*(.*?)$/) {
        push @badarch, split(' ', $1) ;
      }
      if ($line =~ /^#!ExclusiveArch:\s*(.*?)$/) {
        push @requiredarch, split(' ', $1) ;
      }
      if ($line =~ /^#!ArchExclusiveLine:\s*(.*?)$/) {
	my $arch = gettargetarch($cf);
	$excludedline = (grep {$_ eq $arch} split(' ', $1)) ? undef : 1;
      }
      if ($line =~ /^#!ArchExcludedLine:\s*(.*?)$/) {
	my $arch = gettargetarch($cf);
	$excludedline = (grep {$_ eq $arch} split(' ', $1)) ? 1 : undef;
      }
      if ($line =~ /^\#\!RemoteAssetUrl:\s*(\S+)\s*$/i) {
        $remoteasset->{'url'} = $1;
        push @{$ret->{'remoteassets'}}, $remoteasset;
        $remoteasset = undef;
      }
      next;
    }
    $ret->{'exclarch'} = [ unify(@requiredarch) ] if @requiredarch;
    $ret->{'badarch'} = [ unify(@badarch) ] if @badarch;
    # add continuation lines
    while (@lines && $line =~ s/\\[ \t]*$//) {
      shift @lines while @lines && $lines[0] =~ /^\s*#/;
      $line .= shift(@lines) if @lines;
    }
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    next unless $line;
    if ($excludedline) {
      undef $excludedline;
      next;
    }
    my ($cmd, @args);
    ($cmd, $line) = split(' ', $line, 2);
    $cmd = uc($cmd);
    # escape and unquote
    $line =~ s/%/%25/g;
    $line =~ s/\\(.)/sprintf("%%%02X", ord($1))/ge;
    while ($line =~ /([\"\'])/) {
      my $q = $1;
      last unless $line =~ s/$q(.*?)$q/quote($1, $q, $vars)/e;
    }
    if ($cmd eq 'FROM') {
      $vars = { %$vars_meta };		# reset vars
    }
    # split into args then expand
    @args = split(/[ \t]+/, $line);
    for my $arg (@args) {
      $arg = expandvars($arg, $vars) if $arg =~ /\$/;
      $arg =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/ge;
    }
    # process commands
    if ($cmd eq 'FROM') {
      shift @args if @args && $args[0] =~ /^--platform=/;
      if (@args && !$as_container{$args[0]}) {
        $as_container{$args[2]} = $args[0] if @args > 2 && lc($args[1]) eq 'as';
        my $container = $args[0];
        if ($container ne 'scratch') {
	  if ($Build::Kiwi::urlmapper && $container =~ /^([^\/]+\.[^\/]+)\/[a-zA-Z0-9]/) {
	    my $prp = $Build::Kiwi::urlmapper->("registry://$1/");
	    push @containerrepos, $prp if $prp;
	  }
          $container .= ':latest' unless $container =~ /:[^:\/]+$/;
          $container = "container:$container";
          if ($container && !grep {$_ eq $container} @{$ret->{'deps'}}) {
            push @{$ret->{'deps'}}, $container;
          }
        }
      }
      $vars_env = {};		# should take env from base container
      $vars = { %$vars_env };
      $from_seen = 1;
    } elsif ($cmd eq 'RUN') {
      $line =~ s/#.*//;	# get rid of comments
      for my $l (split(/(?:\||\|\||\&|\&\&|;|\)|\()/, $line)) {
	$l =~ s/^\s+//;
	$l =~ s/\s+$//;
	$l = expandvars($l, $vars) if $l =~ /\$/;
	@args = split(/[ \t]+/, $l);
	s/%([a-fA-F0-9]{2})/chr(hex($1))/ge for @args;
	next unless @args;
	my $rcmd = shift @args;
	$rcmd = shift @args if @args && ($rcmd eq 'then' || $rcmd eq 'else' || $rcmd eq 'elif' || $rcmd eq 'if' || $rcmd eq 'do');
	if ($rcmd eq 'zypper') {
	  cmd_zypper($ret, @args);
	} elsif ($rcmd eq 'yum' || $rcmd eq 'dnf') {
	  cmd_dnf($ret, @args);
	} elsif ($rcmd eq 'apt-get') {
	  cmd_apt_get($ret, @args);
	} elsif ($rcmd eq 'curl') {
	  cmd_curl($ret, @args);
	} elsif ($rcmd eq 'obs_pkg_mgr') {
	  cmd_obs_pkg_mgr($ret, @args);
	}
      }
    } elsif ($cmd eq 'ENV') {
      @args=("$args[0]=$args[1]") if @args == 2 && $args[0] !~ /=/;
      for (@args) {
        next unless /^(.*?)=(.*)$/;
	$vars->{$1} = [ $2 ];
	$vars_env->{$1} = [ $2 ];
      }
    } elsif ($cmd eq 'ARG') {
      for (@args) {
	next unless /^([^=]+)(?:=(.*))?$/;
	next if $vars_env->{$1};
	$vars->{$1} = $build_vars{$1} || (defined($2) ? [ $2 ] : $vars_meta->{$1} || []);
	$vars_meta->{$1} = $vars->{$1} unless $from_seen;
      }
    }
  }
  push @{$ret->{'deps'}}, '--unorderedimagerepos' if $unorderedrepos;
  my $version = $ret->{'version'};
  my $release = $cf->{'buildrelease'};
  for (@{$ret->{'containertags'} || []}) {
    s/<VERSION>/$version/g if defined $version;
    s/<RELEASE>/$release/g if defined $release;
  }
  $ret->{'name'} = 'docker' if !defined($ret->{'name'}) && !$cf->{'__dockernoname'};
  $ret->{'path'} = [ { 'project' => '_obsrepositories', 'repository' => '' } ] if $useobsrepositories;
  $ret->{'nosquash'} = 1 if $nosquash;
  if (@containerrepos) {
    for (unify(@containerrepos)) {
      my @s = split('/', $_, 2);
      push @{$ret->{'containerpath'}}, {'project' => $s[0], 'repository' => $s[1] };
    }
  }
  return $ret;
}

sub showcontainerinfo {
  my ($disturl, $release);
  while (@ARGV) {
    if (@ARGV > 2 && $ARGV[0] eq '--disturl') {
      (undef, $disturl) = splice(@ARGV, 0, 2); 
    } elsif (@ARGV > 2 && $ARGV[0] eq '--release') {
      (undef, $release) = splice(@ARGV, 0, 2); 
    } else {
      last;
    }   
  }
  my ($fn, $image, $taglist, $annotationfile) = @ARGV;
  local $Build::Kiwi::urlmapper = sub { return $_[0] };
  my $cf = { '__dockernoname' => 1 };
  $cf->{'buildrelease'} = $release if defined $release;
  my $d = {};
  $d = parse($cf, $fn) if $fn;
  die("$d->{'error'}\n") if $d->{'error'};
  $image =~ s/.*\/// if defined $image;
  my @tags = split(' ', $taglist);
  for (@tags) {
    $_ .= ':latest' unless /:[^:\/]+$/;
    if (/:([0-9][^:]*)$/) {
      $d->{'version'} = $1 unless defined $d->{'version'};
    }
  }
  my @repos = @{$d->{'imagerepos'} || []};
  if ($annotationfile) {
    my $annotation = slurp($annotationfile);
    $annotation = Build::SimpleXML::parse($annotation) if $annotation;
    $annotation = $annotation && ref($annotation) eq 'HASH' ? $annotation->{'annotation'} : undef;
    $annotation = $annotation && ref($annotation) eq 'ARRAY' ? $annotation->[0] : undef;
    my $annorepos = $annotation && ref($annotation) eq 'HASH' ? $annotation->{'repo'} : undef;
    $annorepos = undef unless $annorepos && ref($annorepos) eq 'ARRAY';
    for my $annorepo (@{$annorepos || []}) {
      next unless $annorepo && ref($annorepo) eq 'HASH' && $annorepo->{'url'};
      push @repos, { 'url' => $annorepo->{'url'}, '_type' => {'priority' => 'number'} };
      $repos[-1]->{'priority'} = $annorepo->{'priority'} if defined $annorepo->{'priority'};
    }
  }
  my $buildtime = time();
  my $containerinfo = {
    'buildtime' => $buildtime,
    '_type' => {'buildtime' => 'number'},
  };
  $containerinfo->{'tags'} = \@tags if @tags;
  $containerinfo->{'repos'} = \@repos if @repos;
  $containerinfo->{'file'} = $image if defined $image;
  $containerinfo->{'disturl'} = $disturl if defined $disturl;
  $containerinfo->{'name'} = $d->{'name'} if defined $d->{'name'};
  $containerinfo->{'version'} = $d->{'version'} if defined $d->{'version'};
  $containerinfo->{'release'} = $release if defined $release;
  $containerinfo->{'milestone'} = $d->{'milestone'} if defined $d->{'milestone'};
  print Build::SimpleJSON::unparse($containerinfo)."\n";
}

sub show {
  my ($release);
  while (@ARGV) {
    if (@ARGV > 2 && $ARGV[0] eq '--release') {
      (undef, $release) = splice(@ARGV, 0, 2); 
    } else {
      last;
    }   
  }
  my ($fn, $field) = @ARGV;
  local $Build::Kiwi::urlmapper = sub { return $_[0] };
  my $cf = {};
  $cf->{'buildrelease'} = $release if defined $release;
  my $d = {};
  $d = parse($cf, $fn) if $fn;
  die("$d->{'error'}\n") if $d->{'error'};
  my $x = $d->{$field};
  $x = [ $x ] unless ref $x;
  print "@$x\n";
}

1;
07070100000007000081a400000000000000000000000163e504b9000016b6000000000000000000000000000000000000001200000000Build/Download.pm################################################################
#
# Copyright (c) 2021 SUSE LLC
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Download;

use strict;

use LWP::UserAgent;
use Digest::MD5 ();
use Digest::SHA ();

#
# Create a user agent used to access remote servers
#
sub create_ua {
  my (%opt) = @_;
  my $agent = $opt{'agent'} || 'openSUSE build script';
  my $timeout = $opt{'timeout'} || 60;
  my $ssl_opts = $opt{'ssl_opts'} || { verify_hostname => 1 };
  my $ua = LWP::UserAgent->new(agent => $agent, timeout => $timeout, ssl_opts => $ssl_opts);
  $ua->env_proxy;
  return $ua;
}

#
# Create a hash context from a digest
#
sub digest2ctx {
  my ($digest) = @_;
  return Digest::SHA->new(1) if $digest =~ /^sha1?:/i;
  return Digest::SHA->new($1) if $digest =~ /^sha(\d+):/i;
  return Digest::MD5->new() if $digest =~ /^md5:/i;
  return undef;
}

#
# Verify that some data matches a digest
#
sub checkdigest {
  my ($data, $digest) = @_;
  my $ctx = digest2ctx($digest);
  die("unsupported digest algo '$digest'\n") unless $ctx;
  $ctx->add($data);
  my $hex = $ctx->hexdigest();
  if (lc($hex) ne lc((split(':', $digest, 2))[1])) {
    die("digest mismatch: $digest, got $hex\n");
  }
}

#
# Call the get method with the correct max size setting
#
sub ua_get {
  my ($ua, $url, $maxsize, @hdrs) = @_;
  my $res;
  if (defined($maxsize)) {
    my $oldmaxsize = $ua->max_size($maxsize);
    $res = $ua->get($url, @hdrs);
    $ua->max_size($oldmaxsize);
    die("download of $url failed: ".$res->header('X-Died')) if $res->header('Client-Aborted') && $res->header('X-Died');
    die("download of $url failed: max size exceeded\n") if $res->header('Client-Aborted');
  } else {
    $res = $ua->get($url, @hdrs);
  }
  return $res;
}

sub ua_head {
  my ($ua, $url, $maxsize, @hdrs) = @_;
  return $ua->head($url, @hdrs);
}

#
# Download a file with the correct max size setting
#
sub ua_mirror {
  my ($ua, $url, $dest, $maxsize, @hdrs) = @_;
  my $res = ua_get($ua, $url, $maxsize, ':content_file', $dest, @hdrs);
  die("download of $url failed: ".$res->header('X-Died')) if $res->header('X-Died');
  if ($res->is_success) {
    my @s = stat($dest);
    die("download of $url did not create $dest: $!\n") unless @s;
    my ($cl) = $res->header('Content-length');
    die("download of $url size mismatch: $cl != $s[7]\n") if defined($cl) && $cl != $s[7];
  }
  return $res;
}

#
# Download data from a server
#
sub fetch {
  my ($url, %opt) = @_;
  my $ua = $opt{'ua'} || create_ua();
  my $retry = $opt{'retry'} || 0;
  my $res;
  my @accept;
  @accept = ('Accept', join(', ', @{$opt{'accept'}})) if $opt{'accept'};
  while (1) {
    $res = ua_get($ua, $url, $opt{'maxsize'}, @accept, @{$opt{'headers'} || []});
    last if $res->is_success;
    return undef if $opt{'missingok'} && $res->code == 404;
    my $status = $res->status_line;
    die("download of $url failed: $status\n") unless $retry-- > 0 && $res->previous;
    warn("retrying $url\n");
  }
  my $data = $res->decoded_content;
  my $ct = $res->header('content_type');
  checkdigest($data, $opt{'digest'}) if $opt{'digest'};
  return ($data, $ct);
}

#
# Do a HEAD request
#
sub head {
  my ($url, %opt) = @_;
  my $ua = $opt{'ua'} || create_ua();
  my $retry = $opt{'retry'} || 0;
  my $res;
  my @accept;
  @accept = ('Accept', join(', ', @{$opt{'accept'}})) if $opt{'accept'};
  while (1) {
    $res = ua_head($ua, $url, $opt{'maxsize'}, @accept, @{$opt{'headers'} || []});
    last if $res->is_success;
    return undef if $opt{'missingok'} && $res->code == 404;
    my $status = $res->status_line;
    die("head request of $url failed: $status\n") unless $retry-- > 0 && $res->previous;
    warn("retrying $url\n");
  }
  my $data = { $res->flatten() };
  $data = { map {lc($_) => $data->{$_}} sort keys %$data };
  my $ct = $res->header('content_type');
  return ($data, $ct);
}

#
# Verify that the content of a file matches a digest
#
sub checkfiledigest {
  my ($file, $digest) = @_;
  my $ctx = digest2ctx($digest);
  die("$file: unsupported digest algo '$digest'\n") unless $ctx;
  my $fd;
  open ($fd, '<', $file) || die("$file: $!\n");
  $ctx->addfile($fd);
  close($fd);
  my $hex = $ctx->hexdigest();
  if (lc($hex) ne lc((split(':', $digest, 2))[1])) {
    die("$file: digest mismatch: $digest, got $hex\n");
  }
}

#
# Download a file from a server
#
sub download {
  my ($url, $dest, $destfinal, %opt) = @_;
  my $ua = $opt{'ua'} || create_ua();
  my $retry = $opt{'retry'} || 0;
  while (1) {
    unlink($dest);        # just in case
    my $res = eval { ua_mirror($ua, $url, $dest, $opt{'maxsize'}, @{$opt{'headers'} || []}) };
    if ($@) {
      unlink($dest);
      die($@);
    }
    last if $res->is_success;
    return undef if $opt{'missingok'} && $res->code == 404;
    my $status = $res->status_line;
    die("download of $url failed: $status\n") unless $retry-- > 0 && $res->previous;
    warn("retrying $url\n");
  }
  checkfiledigest($dest, $opt{'digest'}) if $opt{'digest'};
  if ($destfinal) {
    rename($dest, $destfinal) || die("rename $dest $destfinal: $!\n");
  }
  return 1;
}

1;
07070100000008000081a400000000000000000000000163e504b900004d97000000000000000000000000000000000000001000000000Build/Expand.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Expand;

use strict;

our $expand_dbg;

# XXX: should also check the package EVR
sub nevrmatch {
  my ($config, $r, @p) = @_;
  my $rn = $r;
  $rn =~ s/\s*([<=>]{1,2}).*$//;
  return grep {$_ eq $rn} @p;
}

# check if package $q has a conflict against an installed package.
# if yes, add message to @$eq and return true
sub checkconflicts {
  my ($config, $ins, $q, $eq, @r) = @_;
  my $whatprovides = $config->{'whatprovidesh'};
  my $ret = 0;
  for my $r (@r) {
    if ($r =~ /^$.*$$/) {
      # note the []: we ignore errors here. they will be reported if the package is chosen.
      my $n = normalizerich($config, $q, $r, 1, []);
      $ret = 1 if check_conddeps_notinst($q, $n, $eq, $ins);
      next;
    }
    my @eq = grep {$ins->{$_}} @{$whatprovides->{$r} || Build::addproviders($config, $r)};
    next unless @eq;
    push @$eq, map {"(provider $q conflicts with $_)"} @eq;
    $ret = 1;
  }
  return $ret;
}

sub checkobsoletes {
  my ($config, $ins, $q, $eq, @r) = @_;
  my $whatprovides = $config->{'whatprovidesh'};
  my $ret = 0;
  for my $r (@r) {
    my @eq = grep {$ins->{$_}} nevrmatch($config, $r, @{$whatprovides->{$r} || Build::addproviders($config, $r)});
    next unless @eq;
    push @$eq, map {"(provider $q obsoletes $_)"} @eq;
    $ret = 1;
  }
  return $ret;
}

sub todo2recommended {
  my ($config, $recommended, $todo) = @_;
  my $whatprovides = $config->{'whatprovidesh'};
  my $pkgrecommends = $config->{'recommendsh'} || {};
  for my $p (splice @$todo) {
    for my $r (@{$pkgrecommends->{$p} || []}) {
      $recommended->{$_} = 1 for @{$whatprovides->{$r} || Build::addproviders($config, $r)}
    }
  }
}

sub cplx_mix {
  my ($q1, $q2, $todnf) = @_;
  my @q;
  for my $qq1 (@$q1) {
    for my $qq2 (@$q2) {
      my %qq = map {$_ => 1} (@$qq1, @$qq2);
      my @qq = sort keys %qq;
      push @q, \@qq unless grep {$qq{"-$_"}} @qq;
    }
  }
  return $todnf ? 0 : 1 unless @q;
  return (-1, @q);
}

sub cplx_inv {
  my ($f, @q) = @_;
  return 1 - $f if $f == 0 || $f == 1;
  my @iq;
  for my $q (@q) {
    $q = [ map {"-$_"} @$q ];
    s/^--// for @$q;
  }
  return (-1, @q);
}

sub normalize_cplx_rec {
  my ($c, $r, $todnf) = @_;
  if ($r->[0] == 0) {
    my $ri = (split(/[ <=>]/, $r->[1], 2))[0];
    my ($config, $p, $ignore, $xignore) = @$c;
    if (!$todnf) {
      return 1 if $ignore->{$ri} || $xignore->{$ri};
      return 1 if defined($p) && ($ignore->{"$p:$ri"} || $xignore->{"$p:$ri"});
    }
    my $whatprovides = $config->{'whatprovidesh'};
    my @q = @{$whatprovides->{$r->[1]} || Build::addproviders($config, $r->[1])};
    return 0 unless @q;
    if ($todnf) {
      return (-1, map { [ $_ ] } @q);
    } else {
      return (-1, [ @q ]);
    }
  }
  if ($r->[0] == 3 && @$r == 4) {
    # complex if/else case: A IF (B ELSE C) -> (A OR ~B) AND (C OR B)
    my ($n1, @q1) = normalize_cplx_rec($c, [3, $r->[1], $r->[2]], $todnf);
    my ($n2, @q2) = normalize_cplx_rec($c, [2, $r->[2], $r->[3]], $todnf);
    return 0 if $n1 == 0 || $n2 == 0;
    return ($n2, @q2) if $n1 == 1;
    return ($n1, @q1) if $n2 == 1;
    if (!$todnf) {
      return (-1, @q1, @q2);
    } else {
      return cplx_mix(\@q1, \@q2, $todnf);
    }
  }
  if ($r->[0] == 4 && @$r == 4) {
    # complex unless/else case: A UNLESS (B ELSE C) -> (A AND ~B) OR (C AND B)
    my ($n1, @q1) = normalize_cplx_rec($c, [4, $r->[1], $r->[2]], $todnf);
    my ($n2, @q2) = normalize_cplx_rec($c, [1, $r->[2], $r->[3]], $todnf);
    return 1 if $n1 == 1 || $n2 == 1;
    return ($n2, @q2) if $n1 == 0;
    return ($n1, @q1) if $n2 == 0;
    if ($todnf) {
      return (-1, @q1, @q2);
    } else {
      return cplx_mix(\@q1, \@q2, $todnf);
    }
  }
  if ($r->[0] == 1 || $r->[0] == 4) {
    # and / unless
    my $todnf2 = $r->[0] == 4 ? !$todnf : $todnf;
    my ($n1, @q1) = normalize_cplx_rec($c, $r->[1], $todnf);
    my ($n2, @q2) = normalize_cplx_rec($c, $r->[2], $todnf);
    ($n2, @q2) = cplx_inv($n2, @q2) if $r->[0] == 4;
    return 0 if $n1 == 0 || $n2 == 0;
    return ($n2, @q2) if $n1 == 1;
    return ($n1, @q1) if $n2 == 1;
    if (!$todnf) {
      return (-1, @q1, @q2);
    } else {
      return cplx_mix(\@q1, \@q2, $todnf);
    }
  }
  if ($r->[0] == 2 || $r->[0] == 3) {
    # or / if
    my $todnf2 = $r->[0] == 3 ? !$todnf : $todnf;
    my ($n1, @q1) = normalize_cplx_rec($c, $r->[1], $todnf);
    my ($n2, @q2) = normalize_cplx_rec($c, $r->[2], $todnf2);
    ($n2, @q2) = cplx_inv($n2, @q2) if $r->[0] == 3;
    return 1 if $n1 == 1 || $n2 == 1;
    return ($n2, @q2) if $n1 == 0;
    return ($n1, @q1) if $n2 == 0;
    if ($todnf) {
      return (-1, @q1, @q2);
    } else {
      return cplx_mix(\@q1, \@q2, $todnf);
    }
  }
  if ($r->[0] == 6 || $r->[0] == 7) {
    # with / without
    my ($n1, @q1) = normalize_cplx_rec($c, $r->[1], 0);
    my ($n2, @q2) = normalize_cplx_rec($c, $r->[2], 0);
    if ($n2 == 0 && $r->[0] == 7) {
      @q2 = ( [] );
      $n2 = -1;
    }
    return 0 if $n1 != -1 || $n2 != -1;
    return 0 if @q1 != 1 || @q2 != 1;
    @q1 = @{$q1[0]};
    @q2 = @{$q2[0]};
    return 0 if grep {/^-/} @q1;
    return 0 if grep {/^-/} @q2;
    my %q2 = map {$_ => 1} @q2;
    my @q;
    if ($r->[0] == 6) {
      @q = grep {$q2{$_}} @q1;
    } else {
      @q = grep {!$q2{$_}} @q1;
    }
    return 0 unless @q;
    if ($todnf) {
      return (-1, map { [ $_ ] } @q);
    } else {
      return (-1, [ @q ]);
    }
  }
  return 0;
}

sub normalizerich {
  my ($config, $p, $dep, $deptype, $error, $ignore, $xignore) = @_;
  my $r = Build::Rpm::parse_rich_dep($dep);
  if (!$r) {
    if (defined($p)) {
      push @$error, "cannot parse dependency $dep from $p";
    } else {
      push @$error, "cannot parse dependency $dep";
    }
    return [];
  }
  my $c = [$config, $p, $ignore || {}, $xignore || {}];
  my ($n, @q);
  if ($deptype == 0) {
    ($n, @q) = normalize_cplx_rec($c, $r);
    return () if $n == 1;
    if (!$n) {
      if (defined($p)) {
        push @$error, "nothing provides $dep needed by $p";
      } else {
        push @$error, "nothing provides $dep";
      }
      return [];
    }
  } else {
    ($n, @q) = normalize_cplx_rec($c, $r, 1);
    ($n, @q) = cplx_inv($n, @q);
    if (!$n) {
      if (defined($p)) {
        push @$error, "$p conflicts with always true $dep";
      } else {
        push @$error, "conflict with always true $dep";
      }
    }
  }
  for my $q (@q) {
    my @neg = @$q;
    @neg = grep {s/^-//} @neg;
    @neg = grep {$_ ne $p} @neg if defined $p;
    @$q = grep {!/^-/} @$q;
    $q = [$dep, $deptype, \@neg, @$q];
  }
  return \@q;
}

# handle a normalized rich dependency from install of package p
# todo_cond is undef if we are re-checking the cond queue
sub check_conddeps_inst {
  my ($p, $n, $error, $installed, $aconflicts, $todo, $todo_cond) = @_;
  for my $c (@$n) {
    my ($r, $rtype, $cond, @q) = @$c; 
    next unless defined $cond;			# already handled?
    next if grep {$installed->{$_}} @q;         # already fulfilled
    my @cx = grep {!$installed->{$_}} @$cond;   # open conditions
    if (!@cx) {
      $c->[2] = undef;				# mark as handled to avoid dups
      if (@q) {
        push @$todo, $c, $p;
      } elsif (@$cond) {
	if (!$rtype) {
	  if (defined($p)) {
	    push @$error, "nothing provides $r needed by $p";
	  } else {
	    push @$error, "nothing provides $r";
	  }
	  next;
	}
	if (defined($p)) {
	  push @$error, map {"$p conflicts with $_"} sort(@$cond);
	} else {
	  push @$error, map {"conflicts with $_"} sort(@$cond);
	}
      }    
    } else {
      if (!@q && @cx == 1) { 
	if (defined($p)) {
          $aconflicts->{$cx[0]} = "is in conflict with $p";
	} else {
          $aconflicts->{$cx[0]} = "is in conflict";
	}
      } elsif ($todo_cond) {
        push @{$todo_cond->{$_}}, [ $c, $p ] for @cx;
      }
    }
  }
}

# handle a normalized rich dependency from a not-yet installed package
# (we just check conflicts)
sub check_conddeps_notinst {
  my ($p, $n, $eq, $installed) = @_;
  my $ret = 0;
  for my $c (@$n) {
    my ($r, $rtype, $cond, @q) = @$c; 
    next if @q || !@$cond || grep {!$installed->{$_}} @$cond;
    push @$eq, map {"(provider $p conflicts with $_)"} sort(@$cond);
    $ret = 1;
  }
  return $ret;
}

sub extractnative {
  my ($config, $r, $p, $foreign) = @_;
  my $ma = $config->{'multiarchh'}->{$p} || '';
  if ($ma eq 'foreign' || ($ma eq 'allowed' && $r =~ /:any/)) {
    if ($expand_dbg && !grep {$r eq $_} @$foreign) {
      print "added $r to foreign dependencies\n";
    }
    push @$foreign, $r;
    return 1;
  }
  return 0;
}

sub expand {
  my ($config, @p) = @_;

my $conflicts = $config->{'conflicth'};
  my $pkgconflicts = $config->{'pkgconflictsh'} || {};
  my $pkgobsoletes = $config->{'pkgobsoletesh'} || {};
  my $prefer = $config->{'preferh'};
  my $ignore = $config->{'ignoreh'};
  my $ignoreconflicts = $config->{'expandflags:ignoreconflicts'};
  my $ignoreignore;
  my $userecommendsforchoices = 1;

my $whatprovides = $config->{'whatprovidesh'};
  my $requires = $config->{'requiresh'};

my $xignore = { map {substr($_, 1) => 1} grep {/^-/} @p };
  $ignoreconflicts = 1 if $xignore->{'-ignoreconflicts--'};
  $ignore = {} if $xignore->{'-ignoreignore--'};
  if ($ignoreignore) {
    $xignore = {};
    $ignore = {};
  }
  my @directdepsend;
  if ($xignore->{'-directdepsend--'}) {
    delete $xignore->{'-directdepsend--'};
    @directdepsend = @p;
    for my $p (splice @p) {
      last if $p eq '--directdepsend--';
      push @p, $p;
    }
    @directdepsend = grep {!/^-/} splice(@directdepsend, @p + 1);
  }

my $extractnative;
  (undef, $extractnative) = splice(@p, 0, 2) if @p > 1 && $p[0] eq '--extractnative--' && ref($p[1]);
  undef $extractnative if $extractnative && !%{$config->{'multiarchh'} || {}};

my %p;		# expanded packages
  my @todo;		# dependencies to install
  my @todo_inst;	# packages we decided to install
  my %todo_cond;
  my %recommended;	# recommended by installed packages
  my @rec_todo;		# installed todo
  my @error;
  my %aconflicts;	# packages we are conflicting with
  my @native;

# handle direct conflicts
  for (grep {/^!/} @p) {
    my $r = /^!!/ ? substr($_, 2) : substr($_, 1);
    if ($r =~ /^$.*$$/) {
      my $n = normalizerich($config, undef, $r, 1, \@error);
      my %naconflicts;
      check_conddeps_inst(undef, $n, \@error, \%p, \%naconflicts, \@todo, \%todo_cond);
      push @{$aconflicts{$_}}, $naconflicts{$_} for keys %naconflicts;
      next;
    }
    my @q = @{$whatprovides->{$r} || Build::addproviders($config, $r)};
    @q = nevrmatch($config, $r, @q) if /^!!/;
    push @{$aconflicts{$_}}, "is in conflict" for @q;
  }
  @p = grep {!/^[-!]/} @p;

# add direct dependency packages. this is different from below,
  # because we add packages even if the dep is already provided and
  # we break ambiguities if the name is an exact match.
  for my $r (splice @p) {
    if ($r =~ /^$.*$$/) {
      push @p, $r;	# rich deps are never direct
      next;
    }
    my @q = @{$whatprovides->{$r} || Build::addproviders($config, $r)};
    my $pn = $r;
    $pn =~ s/ .*//;
    @q = grep {$_ eq $pn} @q;
    if (@q != 1) {
      push @p, $r;
      next;
    }
    my $p = $q[0];
    next if $extractnative && extractnative($config, $r, $p, \@native);
    print "added $p because of $r (direct dep)\n" if $expand_dbg;
    push @todo_inst, $p;
  }

for my $r (@p, @directdepsend) {
    if ($r =~ /^$.*$$/) {
      # rich dep. normalize, put on todo.
      my $n = normalizerich($config, undef, $r, 0, \@error);
      my %naconflicts;
      check_conddeps_inst(undef, $n, \@error, \%p, \%naconflicts, \@todo, \%todo_cond);
      push @{$aconflicts{$_}}, $naconflicts{$_} for keys %naconflicts;
    } else {
      push @todo, $r, undef;
    }
  }

for my $p (@todo_inst) {
    push @error, map {"$p $_"} @{$aconflicts{$p}} if $aconflicts{$p};
  }
  return (undef, @error) if @error;

push @native, '--directdepsend--' if $extractnative;

while (@todo || @todo_inst) {
    # install a set of chosen packages
    # ($aconficts must not be set for any of them)
    if (@todo_inst) {
      if (@todo_inst > 1) {
        my %todo_inst = map {$_ => 1} @todo_inst;
	@todo_inst = grep {delete($todo_inst{$_})} @todo_inst;
      }

# check aconflicts (just in case)
      for my $p (@todo_inst) {
        push @error, map {"$p $_"} @{$aconflicts{$p}} if $aconflicts{$p};
      }
      return (undef, @error) if @error;

# check against old cond dependencies. we do this step by step so we don't get dups.
      for my $p (@todo_inst) {
	$p{$p} = 1;
	if ($todo_cond{$p}) {
          for my $c (@{delete $todo_cond{$p}}) {
	    my %naconflicts;
	    check_conddeps_inst($c->[1], [ $c->[0] ], \@error, \%p, \%naconflicts, \@todo);
	    push @{$aconflicts{$_}}, $naconflicts{$_} for keys %naconflicts;
	  }
	}
        delete $aconflicts{$p};		# no longer needed
      }
      return undef, @error if @error;

# now check our own dependencies
      for my $p (@todo_inst) {
	my %naconflicts;
	my %naobsoletes;
	$naconflicts{$_} = "is in conflict with $p" for @{$conflicts->{$p} || []};
	for my $r (@{$requires->{$p} || []}) {
	  if ($r =~ /^$.*$$/) {
	    my $n = normalizerich($config, $p, $r, 0, \@error, $ignore, $xignore);
	    check_conddeps_inst($p, $n, \@error, \%p, \%naconflicts, \@todo, \%todo_cond);
	    next;
	  }
	  my $ri = (split(/[ <=>]/, $r, 2))[0];
	  next if $ignore->{"$p:$ri"} || $xignore->{"$p:$ri"};
	  next if $ignore->{$ri} || $xignore->{$ri};
	  next if $ri =~ /^rpmlib$"/;
	  next if $ri =~ /^\// && !@{$whatprovides->{$ri} || []};
	  push @todo, ($r, $p);
	}
	if (!$ignoreconflicts) {
	  for my $r (@{$pkgconflicts->{$p}}) {
	    if ($r =~ /^\(.*$$/) {
	      my $n = normalizerich($config, $p, $r, 1, \@error);
	      check_conddeps_inst($p, $n, \@error, \%p, \%naconflicts, \@todo, \%todo_cond);
	      next;
	    }
	    $naconflicts{$_} = "is in conflict with $p" for @{$whatprovides->{$r} || Build::addproviders($config, $r)};
	  }
	  for my $r (@{$pkgobsoletes->{$p}}) {
	    $naobsoletes{$_} =  "is obsoleted by $p" for nevrmatch($config, $r, @{$whatprovides->{$r} || Build::addproviders($config, $r)});
	  }
	}
	if (%naconflicts) {
	  push @error, map {"$p conflicts with $_"} grep {$_ ne $p && $p{$_}} sort keys %naconflicts;
	  push @{$aconflicts{$_}}, $naconflicts{$_} for keys %naconflicts;
	}
	if (%naobsoletes) {
	  push @error, map {"$p obsoletes $_"} grep {$_ ne $p && $p{$_}} sort keys %naobsoletes;
	  push @{$aconflicts{$_}}, $naobsoletes{$_} for keys %naobsoletes;
	}
	push @rec_todo, $p if $userecommendsforchoices;
      }
      return undef, @error if @error;
      @todo_inst = ();
    }
 
    for my $pass (0, 1, 2, 3, 4, 5) {
      my @todo_next;
      while (@todo) {
	my ($r, $p) = splice(@todo, 0, 2);
	my $rtodo = $r;
	my @q;
	if (ref($r)) {
	  ($r, undef, undef, @q) = @$r;
	} else {
	  @q = @{$whatprovides->{$r} || Build::addproviders($config, $r)};
	}
	next if grep {$p{$_}} @q;
	my $pp = defined($p) ? "$p:" : '';
	my $pn = defined($p) ? " needed by $p" : '';
	if (defined($p) && !$ignoreignore) {
	  next if grep {$ignore->{$_} || $xignore->{$_}} @q;
	  next if grep {$ignore->{"$pp$_"} || $xignore->{"$pp$_"}} @q;
	}

if (!@q) {
	  next if defined($p) && ($r =~ /^\// || $r =~ /^rpmlib\(/);
	  push @error, "nothing provides $r$pn";
	  next;
	}

if (@q > 1 && $pass == 0) {
	  push @todo_next, $rtodo, $p;
	  next;
	}

# pass 0: only one provider
	# pass 1: conflict pruning
        my $nq = @q;
	my @eq;
	for my $q (@q) {
	  push @eq, map {"(provider $q $_)"} @{$aconflicts{$q}} if $aconflicts{$q};
	}
	@q = grep {!$aconflicts{$_}} @q;
	if (!$ignoreconflicts) {
	  for my $q (splice @q) {
	    push @q, $q unless @{$pkgconflicts->{$q} || []} && checkconflicts($config, \%p, $q, \@eq, @{$pkgconflicts->{$q}});
	  }
	  for my $q (splice @q) {
	    push @q, $q unless @{$pkgobsoletes->{$q} || []} && checkobsoletes($config, \%p, $q, \@eq, @{$pkgobsoletes->{$q}});
	  }
	}

if (!@q) {
	  push @error, "conflict for providers of $r$pn", sort(@eq);
	  next;
	}
        if (@q == 1) {
	  next if $extractnative && extractnative($config, $r, $q[0], \@native);
	  print "added $q[0] because of $pp$r\n" if $expand_dbg;
	  push @todo_inst, $q[0];
          next;
        }

# pass 2: prune neg prefers and simple pos prefers
        if ($pass < 2) {
	  print "undecided about $pp$r: @q\n" if $expand_dbg;
	  push @todo_next, $rtodo, $p;
	  next;
        }
	if (@q > 1) {
	  my @pq = grep {!$prefer->{"-$_"} && !$prefer->{"-$pp$_"}} @q;
	  @q = @pq if @pq;
	  @pq = grep {$prefer->{$_} || $prefer->{"$pp$_"}} @q;
	  @q = @pq if @pq == 1;
	}
        if (@q == 1) {
	  next if $extractnative && extractnative($config, $r, $q[0], \@native);
	  push @todo_inst, $q[0];
	  print "added $q[0] because of $pp$r\n" if $expand_dbg;
          next;
        }

# pass 3: prune pos prefers and debian choice deps
        if ($pass < 3) {
	  push @todo_next, $rtodo, $p;
	  next;
        }
	if (@q > 1) {
	  my @pq = grep {$prefer->{$_} || $prefer->{"$pp$_"}} @q;
	  if (@pq > 1) {
	    my %pq = map {$_ => 1} @pq;
	    @q = (grep {$pq{$_}} @{$config->{'prefer'}})[0];
	  } elsif (@pq == 1) {
	    @q = @pq;
	  }
        }
	if (@q > 1 && $r =~ /\|/) {
	  # choice op, implicit prefer of first match...
	  my %pq = map {$_ => 1} @q;
	  for my $rr (split(/\s*\|\s*/, $r)) {
	    next unless $whatprovides->{$rr};
	    my @pq = grep {$pq{$_}} @{$whatprovides->{$rr}};
	      next unless @pq;
	      @q = @pq;
	      last;
	  }
	}
        if (@q == 1) {
	  next if $extractnative && extractnative($config, $r, $q[0], \@native);
	  push @todo_inst, $q[0];
	  print "added $q[0] because of $pp$r\n" if $expand_dbg;
          next;
        }

# pass 4: prune recommends
        if ($pass < 4) {
	  push @todo_next, $rtodo, $p;
	  next;
        }
	todo2recommended($config, \%recommended, \@rec_todo) if @rec_todo;
	my @pq = grep {$recommended{$_}} @q;
	print "recommended [@pq] among [@q]\n" if $expand_dbg;
	@q = @pq if @pq;
        if (@q == 1) {
	  next if $extractnative && extractnative($config, $r, $q[0], \@native);
	  push @todo_inst, $q[0];
	  print "added $q[0] because of $pp$r\n" if $expand_dbg;
          next;
        }

# pass 5: record error
        if ($pass < 5) {
	  push @todo_next, $rtodo, $p;
	  next;
        }
	@q = sort(@q);
	if (defined($p)) {
	  push @error, "have choice for $r needed by $p: @q";
	} else {
	  push @error, "have choice for $r: @q";
	}
      }
      @todo = @todo_next;
      last if @todo_inst;
    }
    return undef, @error if @error;
  }

if ($extractnative && @native) {
    my %rdone;
    for my $r (splice @native) {
      next if $rdone{$r}++;
      if ($r eq '--directdepsend--') {
 	push @native, $r;
	next;
      }
      my @q = @{$whatprovides->{$r} || Build::addproviders($config, $r)};
      push @native, $r unless grep {$p{$_}} @q;
    }
    pop @native if @native && $native[-1] eq '--directdepsend--';
    push @$extractnative, @native;
  }

return 1, (sort keys %p);
}

1;
07070100000009000081a400000000000000000000000163e504b9000005eb000000000000000000000000000000000000001100000000Build/Fissile.pm################################################################
#
# Copyright (c) 2017 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Fissile;

use strict;

eval { require YAML::XS; };
*YAML::XS::LoadFile = sub {die("YAML::XS is not available\n")} unless defined &YAML::XS::LoadFile;

sub parse {
  my ($cf, $fn) = @_;

my $yml;
  eval { $yml = YAML::XS::LoadFile($fn); };
  return {'error' => "Failed to parse yml file"} unless $yml;

my $ret = {};
  $ret->{'name'} = $yml->{'Name'} || 'fissile';
  $ret->{'version'} = $yml->{'Version'} if $yml->{'Version'};

my @deps;
  for (@{$yml->{'DockerImageDeps'} || []}) {
    # This generates something like: "container:fissile-dev:201707081450"
    push @deps, "container:$_";
  }
  $ret->{'deps'} = \@deps;

return $ret;
}

1;
0707010000000a000081a400000000000000000000000163e504b9000012d6000000000000000000000000000000000000001100000000Build/Flatpak.pm################################################################
#
# Copyright (c) 2017 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Flatpak;

use strict;
use warnings;
use Build::Deb;
use Build::Rpm;
#use URI; # not installed in kvm?
#use JSON::PP; # not installed in kvm?

my $yamlxs = eval { require YAML::XS; $YAML::XS::LoadBlessed = 0; return 1 };
my $yamlpp = eval { require YAML::PP; return YAML::PP->new };

sub _have_yaml_parser {
  return $yamlpp || $yamlxs ? 1 : undef;
}

sub _load_yaml {
  my ($yaml) = @_;
  my $data;
  if ($yamlpp) {
    $data = eval { $yamlpp->load_string($yaml) };
    return $data;
  }
  if ($yamlxs) {
    eval { $data = YAML::XS::Load($yaml) };
    return $data;
  }
  die "Neither YAML::PP nor YAML::XS available\n";
}

sub _load_yaml_file {
  my ($fn) = @_;
  my $data;
  if ($yamlpp) {
    $data = eval { $yamlpp->load_file($fn) };
    return $data;
  }
  if ($yamlxs) {
    eval { $data = YAML::XS::LoadFile($fn) };
    return $data;
  }
  die "Neither YAML::PP nor YAML::XS available\n";
}

sub _read_manifest {
  my ($fn) = @_;
  my $data;
  if ($fn =~ m/\.ya?ml\z/) {
    $data = _load_yaml_file($fn);
    return { error => "Failed to parse YAML file '$fn'" } unless defined $data;
  } elsif ($fn =~ m/\.json\z/) {
    # We don't have JSON::PP, but YAML is a superset of JSON anyway
    $data = _load_yaml_file($fn);
    return { error => "Failed to parse JSON file '$fn'" } unless defined $data;
  } elsif (ref($fn) eq 'SCALAR') {
    $data = _load_yaml($$fn);		# used in the unit test
    return { error => "Failed to parse '$fn'" } unless defined $data;
  } else {
    $data = _load_yaml_file($fn);
    return { error => "Failed to parse file '$fn'" } unless defined $data;
  }
  return $data;
}

sub parse {
  my ($cf, $fn) = @_;

my $version = '';
  my @lines;
  if (ref($fn) eq 'SCALAR') {
    @lines = split m/(?<=\n)/, $$fn;
  }
  else {
    open my $fh, '<', $fn or return { error => "Failed to open file '$fn'" };
    @lines = <$fh>;
    close $fh;
  }

for my $line (@lines) {
    if ($line =~ m/^#!BuildVersion: (\S+)/) {
      my $string = $1;
      if ($string =~ m/^[0-9.]+$/) {
          $version = $string;
      }
      else {
        return { error => "Invalid BuildVersion" };
      }
    }
  }

my $data = _read_manifest($fn);
  my $ret = {};
  $ret->{version} = $version if $version;
  $ret->{name} = $data->{'app-id'} or die "Flatpak file is missing 'app-id'";
  my $runtime = $data->{runtime};
  my $runtime_version = $data->{'runtime-version'};
  my $sdk = $data->{sdk};

my @packdeps;
  push @packdeps, "$sdk-v$runtime_version";
  push @packdeps, "$runtime-v$runtime_version";
  $ret->{deps} = \@packdeps;

my @sources;
  if (my $modules = $data->{modules}) {
    for my $module (@$modules) {
      if (my $sources = $module->{sources}) {
        for my $source (@$sources) {
          if ($source->{type} eq 'archive') {
            push @sources, $source->{url};
          }
        }
      }
    }
  }
  $ret->{sources} = \@sources;

return $ret;
}

sub show {
    my ($fn, $field) = @ARGV;
    my $cf = {};
    my $d = parse($cf, $fn);
    die "$d->{error}\n" if $d->{error};
    my $value = $d->{ $field };
    if (ref $value eq 'ARRAY') {
        print "$_\n" for @$value;
    }
    else {
        print "$value\n";
    }
}

# This replaces http urls with local file urls because during build
# flatpak-builder has no network
sub rewrite {
  my ($fn) = @ARGV;
  my $data = _read_manifest($fn);
  if (my $modules = $data->{modules}) {
    for my $module (@$modules) {
      if (my $sources = $module->{sources}) {
        for my $source (@$sources) {
          if ($source->{type} eq 'archive') {
            my $path = $source->{url};
            $path =~ s{.*/}{}; # Get filename
            $source->{url} = "file:///usr/src/packages/SOURCES/$path";
          }
        }
      }
    }
  }
  my $yaml = '';
  if ($yamlpp) {
    # YAML::PP would allow us to keep key order
    $yaml = $yamlpp->dump_string($data);
  }
  elsif ($yamlxs) {
    $yaml = YAML::XS::Dump($data);
  }
  print $yaml;
}

1;
0707010000000b000081a400000000000000000000000163e504b900001283000000000000000000000000000000000000000e00000000Build/Helm.pm################################################################
#
# Copyright (c) 2020 SUSE LLC
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Helm;

use strict;

use Build::SimpleJSON;

eval { require YAML::XS; $YAML::XS::LoadBlessed = 0; };
*YAML::XS::LoadFile = sub {die("YAML::XS is not available\n")} unless defined &YAML::XS::LoadFile;

sub verify_config {
  my ($d) = @_;
  die("bad config\n") unless ref($d) eq 'HASH';
  for my $k ('name', 'version') {
    die("missing element '$k'\n") unless defined $d->{$k};
    die("bad element '$k'\n") unless ref($d->{$k}) eq '';
    die("empty element '$k'\n") if $d->{$k} eq '';
    die("bad element '$k'\n\n") if $d->{$k} =~ /[\/\000-\037]/;
  }
  die("bad name\n") if $d->{'name'} =~ /^[-\.]/;
}

sub parse {
  my ($cf, $fn) = @_;
  my $d;
  my $fd;
  return {'error' => "$fn: $!"} unless open($fd, '<', $fn);
  my @tags;
  while (<$fd>) {
    chomp;
    next if /^\s*$/;
    last unless /^\s*#/;
    push @tags, split(' ', $1) if /^#!BuildTag:\s*(.*?)$/;
  }
  close($fd);
  eval {
    $d = YAML::XS::LoadFile($fn);
    verify_config($d);
  };
  if ($@) {
    my $err = $@;
    chomp $@;
    return {'error' => "Failed to parse yml file: $err"};
  }
  
  my $res = {};
  $res->{'name'} = $d->{'name'};
  $res->{'version'} = $d->{'version'};
  $res->{'deps'} = [];
  my $release = $cf->{'buildrelease'};
  for (@tags) {
    s/<NAME>/$d->{'name'}/g;
    s/<VERSION>/$d->{'version'}/g;
    s/<RELEASE>/$release/g;
  }
  $res->{'containertags'} = \@tags if @tags;
  return $res;
}

sub show {
  my ($release, $disturl, $chart, $origrecipe);
  while (@ARGV) {
    if (@ARGV > 2 && $ARGV[0] eq '--release') {
      (undef, $release) = splice(@ARGV, 0, 2); 
    } elsif (@ARGV > 2 && $ARGV[0] eq '--disturl') {
      (undef, $disturl) = splice(@ARGV, 0, 2);
    } elsif (@ARGV > 2 && $ARGV[0] eq '--chart') {
      (undef, $chart) = splice(@ARGV, 0, 2); 
    } elsif (@ARGV > 2 && $ARGV[0] eq '--origrecipe') {
      (undef, $origrecipe) = splice(@ARGV, 0, 2); 
    } else {
      last;
    }   
  }
  my ($fn, $field) = @ARGV;
  my $d = {};
  $d->{'buildrelease'} = $release if defined $release;
  $d = parse({}, $fn) if $fn;
  die("$d->{'error'}\n") if $d->{'error'};

if ($field eq 'helminfo') {
    my $containertags = $d->{'containertags'};
    if ($origrecipe) {
      # we need to parse the original recipe to get the tags
      my $origd = parse({}, $origrecipe);
      $containertags = $origd->{'containertags'};
    }
    my $config_yaml = '';
    my $fd;
    die("$fn: $!\n") unless open($fd, '<', $fn);
    1 while sysread($fd, $config_yaml, 8192, length($config_yaml));
    close($fd);
    my $config = YAML::XS::Load($config_yaml);
    verify_config($config);
    my $config_json = Build::SimpleJSON::unparse($config)."\n";
    my $helminfo = {};
    $helminfo->{'name'} = $d->{'name'};
    $helminfo->{'version'} = $d->{'version'};
    $helminfo->{'release'} = $release if $release;
    $helminfo->{'tags'} = $containertags if $containertags;
    $helminfo->{'disturl'} = $disturl if $disturl;
    $helminfo->{'buildtime'} = time();
    if ($chart) {
      require Digest::SHA;
      $helminfo->{'chart'} = $chart;
      $helminfo->{'chart'} =~ s/.*\///;
      my $ctx = Digest::SHA->new(256);
      my $cfd;
      die("$chart: $!\n") unless open($cfd, '<', $chart);
      my @s = stat($cfd);
      $ctx->addfile($cfd);
      close($cfd);
      $helminfo->{'chart_sha256'} = $ctx->hexdigest;
      $helminfo->{'chart_size'} = $s[7];
    }
    $helminfo->{'config_json'} = $config_json;
    $helminfo->{'config_yaml'} = $config_yaml;
    $helminfo->{'_order'} = [ qw{name version release tags disturl buildtime chart config_json config_yaml chart_sha256 chart_size} ];
    $helminfo->{'_type'} = {'buildtime' => 'number', 'chart_size' => 'number' };
    print Build::SimpleJSON::unparse($helminfo)."\n";
    exit(0);
  }
  $d->{'nameversion'} = "$d->{'name'}-$d->{'version'}";		# convenience
  my $x = $d->{$field};
  $x = [ $x ] unless ref $x;
  print "@$x\n";
}

1;
0707010000000c000081a400000000000000000000000163e504b9000016b0000000000000000000000000000000000000001100000000Build/Intrepo.pm################################################################
#
# Copyright (c) 2020 SUSE LLC
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Intrepo;

use strict;
use Build::Rpm;

# This implements reading and writing of build's internal repo format.
# 
# The format looks like this:
#
# P:bash.x86_64-1526160002/1526160023/0: bash = 4.4-lp150.7.8
#
# i.e.: type:name.arch-mtime/size/inode: dep dep dep
#
# P:provides C:conflicts R:requires O:Obsoletes
# r:recommends s:supplements
#
# There is also:
# F:...: filename
# I:...: ident  where ident == name-evr buildtime-arch
#
# The format is so weird because init_buildsystem of the old autobuild
# system used to create such repos by doing a single 'rpm --qf' call.
#

sub addpkg {
  my ($res, $pkg, $pkgid, $options) = @_;

return unless $pkgid =~ /^(.*)\.(.*)-\d+\/\d+\/\d+$/s;
  $pkg->{'name'} = $1;
  $pkg->{'arch'} = $2 unless $pkg->{'arch'};
  # extract evr from self provides if there was no 'I' line
  if (!defined($pkg->{'version'})) {
    my @sp = grep {/^\Q$pkg->{'name'}\E\s*=\s*/} @{$pkg->{'provides'} || []};
    if (@sp) {
      my $evr = $sp[-1];
      $evr =~ s/^\Q$pkg->{'name'}\E\s*=\s*//;
      $pkg->{'epoch'} = $1 if $evr =~ s/^(\d+)://;
      $pkg->{'release'} = $1 if $evr =~ s/-([^-]*)$//;
      $pkg->{'version'} = $evr;
    }
  }
  if (ref($res) eq 'CODE') {
    $res->($pkg);
  } else {
    push @$res, $pkg;
  }
}

sub parse {
  my ($in, $res, %options) = @_;

my $nofiledeps = $options{'nofiledeps'};
  my $testcaseformat = $options{'testcaseformat'};
  if (ref($in)) {
    *F = $in;
  } else {
    open(F, '<', $in) || die("$in: $!\n");
  }
  $res ||= [];

my $lastpkgid;
  my $pkg = {};
  while (<F>) {
    my @s = split(' ', $_);
    my $s = shift @s;
    next unless $s && $s =~ /^([a-zA-Z]):(.+):$/s;
    my ($tag, $pkgid) = ($1, $2);
    
    if ($lastpkgid && $pkgid ne $lastpkgid) {
      addpkg($res, $pkg, $lastpkgid, \%options) if %$pkg;
      $pkg = {};
    }
    $lastpkgid = $pkgid;

if ($tag eq 'I') {
      next unless $pkgid =~ /^(.*)\.(.*)-\d+\/\d+\/\d+:$/;
      my $name = $1;
      my $evr = $s[0];
      $pkg->{'arch'} = $1 if $s[1] && $s[1] =~ s/-(.*)$//;
      $pkg->{'buildtime'} = $s[1] if $s[1];
      if ($evr =~ s/^\Q$name\E-//) {
	$pkg->{'epoch'} = $1 if $evr =~ s/^(\d+)://;
	$pkg->{'release'} = $1 if $evr =~ s/-([^-]*)$//;
	$pkg->{'version'} = $evr;
      }
      next;
    }
    if ($tag eq 'F') {
      chomp;
      my $loc = (split(' ', $_, 2))[1];
      $pkg->{'location'} = $loc if defined $loc;
      next;
    }
    if ($tag eq 'M') {
      chomp;
      my $multiarch = (split(' ', $_, 2))[1];
      $pkg->{'multiarch'} = $multiarch if $multiarch;
      next;
    }
    my @ss;
    while (@s) {
      if ($nofiledeps && $s[0] =~ /^\//) {
	shift @s;
	next;
      }
      if ($s[0] =~ /^rpmlib$/) {
	splice(@s, 0, 3);
	next;
      }
      if ($s[0] =~ /^\(/) {
	push @ss, Build::Rpm::shiftrich(\@s);
	$ss[-1] = Build::Rpm::testcaseformat($ss[-1]) if $testcaseformat;
	next;
      }
      push @ss, shift @s;
      while (@s && $s[0] =~ /^\(?[<=>|]/) {
	$ss[-1] .= " $s[0] $s[1]";
	$ss[-1] =~ s/ \((.*)$/ $1/;
	$ss[-1] =~ s/(<|>){2}/$1/;
	splice(@s, 0, 2);
      }
    }
    my %ss;
    @ss = grep {!$ss{$_}++} @ss;	# unify
    $pkg->{'provides'} = \@ss if $tag eq 'P';
    $pkg->{'requires'} = \@ss if $tag eq 'R';
    $pkg->{'conflicts'} = \@ss if $tag eq 'C';
    $pkg->{'obsoletes'} = \@ss if $tag eq 'O';
    $pkg->{'recommends'} = \@ss if $tag eq 'r';
    $pkg->{'supplements'} = \@ss if $tag eq 's';
  }
  addpkg($res, $pkg, $lastpkgid, \%options) if $lastpkgid && %$pkg;
  close F unless ref($in);
  return $res;
}

sub getbuildid {
  my ($q) = @_;
  my $evr = $q->{'version'};
  $evr = "$q->{'epoch'}:$evr" if $q->{'epoch'};
  $evr .= "-$q->{'release'}" if defined $q->{'release'};
  my $buildtime = $q->{'buildtime'} || 0;
  $buildtime .= "-$q->{'arch'}" if defined $q->{'arch'};
  return "$q->{'name'}-$evr $buildtime";
}

my $writepkg_inode = 0;

sub writepkg {
  my ($fh, $pkg, $locprefix, $inode) = @_;
  return unless defined($pkg->{'name'}) && defined($pkg->{'arch'});
  return if $pkg->{'arch'} eq 'src' || $pkg->{'arch'} eq 'nosrc';
  $locprefix = '' unless defined $locprefix;
  my $id = $pkg->{'id'};
  if (!$id) {
    $inode = $writepkg_inode++ unless defined $inode;
    $id = ($pkg->{'buildtime'} || 0)."/".($pkg->{'filetime'} || 0)."/$inode";
  }
  $id = "$pkg->{'name'}.$pkg->{'arch'}-$id: ";
  print $fh "F:$id$locprefix$pkg->{'location'}\n";
  print $fh "P:$id".join(' ', @{$pkg->{'provides'} || []})."\n";
  print $fh "R:$id".join(' ', @{$pkg->{'requires'}})."\n" if $pkg->{'requires'};
  print $fh "C:$id".join(' ', @{$pkg->{'conflicts'}})."\n" if $pkg->{'conflicts'};
  print $fh "O:$id".join(' ', @{$pkg->{'obsoletes'}})."\n" if $pkg->{'obsoletes'};
  print $fh "r:$id".join(' ', @{$pkg->{'recommends'}})."\n" if $pkg->{'recommends'};
  print $fh "s:$id".join(' ', @{$pkg->{'supplements'}})."\n" if $pkg->{'supplements'};
  print $fh "M:$id$pkg->{'multiarch'}\n" if $pkg->{'multiarch'};
  print $fh "I:$id".getbuildid($pkg)."\n";
}

1;
0707010000000d000081a400000000000000000000000163e504b90000613c000000000000000000000000000000000000000e00000000Build/Kiwi.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Kiwi;

use strict;
use Build::SimpleXML;
use Build::SimpleJSON;

our $bootcallback;
our $urlmapper;
our $repoextras = 0;	# priority, flags, ...

sub unify {
  my %h = map {$_ => 1} @_;
  return grep(delete($h{$_}), @_);
}

sub expandFallBackArchs {
  my ($fallbackArchXML, @archs) = @_;
  my %fallbacks;
  for (@{$fallbackArchXML->{'arch'} || []}) {
    $fallbacks{$_->{'id'}} = $_->{'fallback'} if $_->{id} && $_->{'fallback'};
  }
  my @out;
  while (@archs) {
    push @out, shift @archs;
    push @archs, delete $fallbacks{$out[-1]} if $fallbacks{$out[-1]};
  }
  return unify(@out);
}

# sles10 perl does not have the version.pm
# implement own hack
sub versionstring {
  my ($str) = @_; 
  my $result = 0;
  $result = $result * 100 + $_ for split (/\./, $str, 2);
  return $result;
}

my $schemaversion56 = versionstring('5.6');

sub kiwiparse_product {
  my ($kiwi, $xml, $arch, $buildflavor) = @_;

my $ret = {};
  my @repos;
  my %repoprio;		# XXX: unused
  my @packages;
  my @requiredarch;
  my @badarch;
  my $obsexclusivearch;
  my $obsexcludearch;
  $obsexclusivearch = $1 if $xml =~ /^\s*\s*$/im;
  $obsexcludearch = $1 if $xml =~ /^\s*\s*$/im;
  $ret->{'milestone'} = $1 if $xml =~ /^\s*\s*$/im;

$ret->{'name'} = $kiwi->{'name'} if $kiwi->{'name'};
  $ret->{'filename'} = $kiwi->{'name'} if $kiwi->{'name'};
  my $description = (($kiwi->{'description'} || [])->[0]) || {};
  if (!$ret->{'name'} && $description->{'specification'}) {
    $ret->{'name'} = $description->{'specification'}->[0]->{'_content'};
  }

# parse the preferences section
  my $preferences = $kiwi->{'preferences'} || [];
  die("products must have exactly one preferences element\n") unless @$preferences == 1;
  # take default version setting
  if ($preferences->[0]->{'version'}) {
    $ret->{'version'} = $preferences->[0]->{'version'}->[0]->{'_content'};
  }
  die("products must have exactly one type element in the preferences\n") unless @{$preferences->[0]->{'type'} || []} == 1;
  my $preftype = $preferences->[0]->{'type'}->[0];
  if (defined $preftype->{'image'}) {
    # for kiwi 4.1 and 5.x
    die("products must use type 'product'\n") unless $preftype->{'image'} eq 'product';
  } else {
    # for kiwi 3.8 and before
    die("products must use type 'product'\n") unless $preftype->{'_content'} eq 'product';
  }
  push @packages, "kiwi-filesystem:$preftype->{'filesystem'}" if $preftype->{'filesystem'};
  die("boot type not supported in products\n") if defined $preftype->{'boot'};

my $instsource = ($kiwi->{'instsource'} || [])->[0];
  die("products must have an instsource element\n") unless $instsource;

# get repositories
  for my $repository (sort {$a->{priority} <=> $b->{priority}} @{$instsource->{'instrepo'} || []}) {
    my $kiwisource = ($repository->{'source'} || [])->[0];
    if ($kiwisource->{'path'} eq 'obsrepositories:/') {
      push @repos, '_obsrepositories/';		# special case, OBS will expand it.
    } elsif ($kiwisource->{'path'} =~ /^obs:\/\/\/?([^\/]+)\/([^\/]+)\/?$/) {
      push @repos, "$1/$2";
    } else {
      my $prp;
      $prp = $urlmapper->($kiwisource->{'path'}) if $urlmapper;
      die("instsource repo url not using obs:/ scheme: $kiwisource->{'path'}\n") unless $prp;
      push @repos, $prp;
    }
  }

$ret->{'sourcemedium'} = -1;
  $ret->{'debugmedium'} = -1;
  if ($instsource->{'productoptions'}) {
    my $productoptions = $instsource->{'productoptions'}->[0] || {};
    for my $po (@{$productoptions->{'productvar'} || []}) {
      $ret->{'drop_repository'} = $po->{'_content'} if $po->{'name'} eq 'DROP_REPOSITORY';
      $ret->{'version'} = $po->{'_content'} if $po->{'name'} eq 'VERSION';
    }
    for my $po (@{$productoptions->{'productoption'} || []}) {
      $ret->{'sourcemedium'} = $po->{'_content'} if $po->{'name'} eq 'SOURCEMEDIUM';
      $ret->{'debugmedium'} = $po->{'_content'} if $po->{'name'} eq 'DEBUGMEDIUM';
      $ret->{'milestone'} = $po->{'_content'} if $po->{'name'} eq 'BETA_VERSION';
    }
  }
  if ($instsource->{'architectures'}) {
    my $architectures = $instsource->{'architectures'}->[0] || {};
    for my $ra (@{$architectures->{'requiredarch'} || []}) {
      push @requiredarch, $ra->{'ref'} if defined $ra->{'ref'};
    }
  }

# Find packages and possible additional required architectures
  my @additionalarchs;
  my @pkgs;
  push @pkgs, @{$instsource->{'metadata'}->[0]->{'repopackage'} || []} if $instsource->{'metadata'};
  push @pkgs, @{$instsource->{'repopackages'}->[0]->{'repopackage'} || []} if $instsource->{'repopackages'};
  @pkgs = unify(@pkgs);
  for my $package (@pkgs) {
    # filter packages, which are not targeted for the wanted plattform
    if ($package->{'arch'}) {
      my $valid;
      for my $ma (@requiredarch) {
        for my $pa (split(',', $package->{'arch'})) {
          $valid = 1 if $ma eq $pa;
        }
      }
      next unless $valid;
    }

# not nice, but optimizes our build dependencies
    # FIXME: design a real blacklist option in kiwi
    if ($package->{'onlyarch'} && $package->{'onlyarch'} eq 'skipit') {
      push @packages, "-$package->{'name'}";
      next;
    }
    push @packages, "-$package->{'replaces'}" if $package->{'replaces'};

# we need this package
    push @packages, $package->{'name'};

# find the maximal superset of possible required architectures
    push @additionalarchs, split(',', $package->{'addarch'}) if $package->{'addarch'};
    push @additionalarchs, split(',', $package->{'onlyarch'}) if $package->{'onlyarch'};
  }
  @requiredarch = unify(@requiredarch, @additionalarchs);

#### FIXME: kiwi files have no informations where to get -32bit packages from
  push @requiredarch, "i586" if grep {/^ia64/} @requiredarch;
  push @requiredarch, "i586" if grep {/^x86_64/} @requiredarch;
  push @requiredarch, "ppc" if grep {/^ppc64/} @requiredarch;
  push @requiredarch, "s390" if grep {/^s390x/} @requiredarch;
  
  @requiredarch = expandFallBackArchs($instsource->{'architectures'}->[0], @requiredarch);

push @packages, "kiwi-packagemanager:instsource";

push @requiredarch, split(' ', $obsexclusivearch) if $obsexclusivearch;
  push @badarch , split(' ', $obsexcludearch) if $obsexcludearch;

$ret->{'exclarch'} = [ unify(@requiredarch) ] if @requiredarch;
  $ret->{'badarch'} = [ unify(@badarch) ] if @badarch;
  $ret->{'deps'} = [ unify(@packages) ];
  $ret->{'path'} = [ unify(@repos) ];
  $ret->{'imagetype'} = [ 'product' ];
  for (@{$ret->{'path'} || []}) {
    my @s = split('/', $_, 2);
    $_ = {'project' => $s[0], 'repository' => $s[1]};
    $_->{'priority'} = $repoprio{"$s[0]/$s[1]"} if $repoextras && defined $repoprio{"$s[0]/$s[1]"};
  }
  return $ret;
}

sub unify_repo {
  my ($repo) = @_;
  my @r;
  my %seen;
  for (@{$repo || []}) {
    if ($_->{'url'}) {
      next if $seen{$_->{'url'}};
      $seen{$_->{'url'}} = 1;
    }
    push @r, $_;
  }
  return \@r;
}

sub kiwiparse {
  my ($xml, $arch, $buildflavor, $release, $count) = @_;
  $count ||= 0;
  die("kiwi config inclusion depth limit reached\n") if $count++ > 10;

my $kiwi = Build::SimpleXML::parse($xml);
  die("not a kiwi config\n") unless $kiwi && $kiwi->{'image'};
  $kiwi = $kiwi->{'image'}->[0];

# check if this is a product, we currently test for the 'instsource' element
  return kiwiparse_product($kiwi, $xml, $arch, $buildflavor) if $kiwi->{'instsource'};

my $ret = {};
  my @types;
  my @repos;
  my @imagerepos;
  my @bootrepos;
  my @containerrepos;
  my @packages;
  my @extrasources;
  my $obsexclusivearch;
  my $obsexcludearch;
  my $obsprofiles;
  my $unorderedrepos;
  my @ignorepackages;
  $obsexclusivearch = $1 if $xml =~ /^\s*\s*$/im;
  $obsexcludearch = $1 if $xml =~ /^\s*\s*$/im;
  $obsprofiles = $1 if $xml =~ /^\s*\s*$/im;
  $ret->{'milestone'} = $1 if $xml =~ /^\s*\s*$/im;
  if ($obsprofiles) {
    $obsprofiles = [ grep {defined($_)} map {$_ eq '@BUILD_FLAVOR@' ? $buildflavor : $_} split(' ', $obsprofiles) ];
  }
  $unorderedrepos = 1 if $xml =~ /^\s*\s*$/im;
  $ret->{'donotappendprofiletocontainername'} = 1 if $xml =~ /^\s*\s*$/im;
  for ($xml =~ /^\s*\s*$/img) {
    push @imagerepos, { 'url' => $_ };
  }
  for ($xml =~ /^\s*\s*$/img) {
    push @ignorepackages, split(' ', $_);
  }
  for ($xml =~ /^\s*\s*$/img) {
    my @s = split(' ', $_);
    my $remoteasset = { 'url' => $s[0] };
    $remoteasset->{'digest'} = $s[1] if $s[1] && $s[1] =~ /^[a-z0-9]+:[0-9a-f]+$/;
    push @{$ret->{'remoteassets'}}, $remoteasset;
  }
  for ($xml =~ /^\s*\s*$/img) {
    my @s = split(' ', $_);
    next if !$s[0] || $s[0] eq '.' || $s[0] eq '..' || $s[0] =~ /\// || $s[0] eq 'root';
    push @s, $s[0] unless @s > 1;
    push @{$ret->{'copytoimage'}}, "$s[0] $s[1]";
  }

my $schemaversion = $kiwi->{'schemaversion'} ? versionstring($kiwi->{'schemaversion'}) : 0;
  $ret->{'name'} = $kiwi->{'name'} if $kiwi->{'name'};
  $ret->{'filename'} = $kiwi->{'name'} if $kiwi->{'name'};
  my $description = (($kiwi->{'description'} || [])->[0]) || {};
  if (!$ret->{'name'} && $description->{'specification'}) {
    $ret->{'name'} = $description->{'specification'}->[0]->{'_content'};
  }

# usedprofiles also include direct wanted profile targets and indirect required profiles
  my %usedprofiles;
  # obsprofiles arch filtering
  if ($obsprofiles && $arch && $kiwi->{'profiles'} && $kiwi->{'profiles'}->[0]->{'profile'}) {
    # reduce set of profiles to the ones matching our architecture
    my @validprofiles;
    for my $prof (@{$kiwi->{'profiles'}[0]->{'profile'}}) {
      next unless $prof->{'name'};
      if (!$prof->{'arch'}) {
	push @validprofiles, $prof;
      } else {
	my $ma = $arch;
	$ma =~ s/i[456]86/i386/;
	for my $pa (split(",", $prof->{'arch'})) {
	  $pa =~ s/i[456]86/i386/;
	  next unless $ma eq $pa;
	  push @validprofiles, $prof;
	  last;
	}
      }
    }
    my %validprofiles = map {$_->{'name'} => 1} @validprofiles;
    $obsprofiles = [ grep {$validprofiles{$_}} @$obsprofiles ];
    my %obsprofiles = map {$_ => 1} @$obsprofiles;
    my @todo = grep {$obsprofiles{$_->{'name'}}} @validprofiles;
    while (@todo) {
      my $prof = shift @todo;
      next if $usedprofiles{$prof->{'name'}};	# already done
      $usedprofiles{$prof->{'name'}} = 1;
      for my $req (@{$prof->{'requires'} || []}) {
	push @todo, grep {$_->{'name'} eq $req->{'profile'}} @validprofiles;
      }
    }
  }

# take default version setting
  my $preferences = ($kiwi->{'preferences'} || []);
  if ($preferences->[0]->{'version'}) {
    $ret->{'version'} = $preferences->[0]->{'version'}->[0]->{'_content'};
  }

# add extra tags
  my @extratags;
  if ($xml =~ /^\s*\s*$/im) {
    for (split(' ', $1)) {
      s/<VERSION>/$ret->{'version'}/g if $ret->{'version'};
      s/<RELEASE>/$release/g if $release;
      $_ = "$_:latest" unless /:[^\/]+$/;
      push @extratags, $_;
    }
  }

my $containerconfig;
  for my $pref (@{$preferences || []}) {
    if ($obsprofiles && $pref->{'profiles'}) {
      next unless grep {$usedprofiles{$_}} split(",", $pref->{'profiles'});
    }
    for my $type (@{$pref->{'type'} || []}) {
      next unless @{$pref->{'type'}} == 1 || !$type->{'optional'};
      if (defined $type->{'image'}) {
        # for kiwi 4.1 and 5.x
        push @types, $type->{'image'};
        push @packages, "kiwi-image:$type->{'image'}" if $schemaversion >= $schemaversion56;
      } else {
        # for kiwi 3.8 and before
        push @types, $type->{'_content'};
      }
      # save containerconfig so that we can retrieve the tag
      $containerconfig = $type->{'containerconfig'}->[0] if $type->{'containerconfig'};

# add derived container dependency
      if ($type->{'derived_from'}) {
	my $derived = $type->{'derived_from'};
	my ($name, $prp);
	if ($derived =~ /^obs:\/{1,3}([^\/]+)\/([^\/]+)\/(.*?)(?:#([^\#\/]+))?$/) {
	  $name = defined($4) ? "$3:$4" : "$3:latest";
	  $prp = "$1/$2";
	  $prp = "obs:/$prp" if defined($urlmapper) && !$urlmapper;
	} elsif ($derived =~ /^obsrepositories:\/{1,3}([^\/].*?)(?:#([^\#\/]+))?$/) {
	  $name = defined($2) ? "$1:$2" : "$1:latest";
	} elsif ($derived =~ /^file:/) {
	  next;		# just ignore and hope
	} elsif (defined($urlmapper) && !$urlmapper) {
	  if ($derived =~ /^https:\/\/([^\/]+)\/(.*?)(?:#([^\#\/]+))?$/) {
	    $prp = $1;
	    $name = defined($3) ? "$2:$3" : "$2:latest";
	  } elsif ($derived =~ /([^\/]+\.[^\/]+)\/(.*?)(?:#([^\#\/]+))?$/) {
	    $prp = "https://$1";
	    $name = defined($3) ? "$2:$3" : "$2:latest";
	  } elsif ($derived =~ /^(.*?)(?:#([^\#\/]+))?$/) {
	    $name = defined($2) ? "$1:$2" : "$1:latest";
	  } else {
	    die("cannot decode derived_from: $derived\n");
	  }
	} elsif ($derived =~ /^(.*)\/([^\/]+?)(?:#([^\#\/]+))?$/) {
	  my $url = $1;
	  $name = defined($3) ? "$2:$3" : "$2:latest";
	  $prp = $urlmapper->($url) if $urlmapper;
	  # try again with one element moved from url to name
	  if (!$prp && $derived =~ /^(.*)\/([^\/]+\/[^\/]+?)(?:#([^\#\/]+))?$/) {
	    $url = $1;
	    $name = defined($3) ? "$2:$3" : "$2:latest";
	    $prp = $urlmapper->($url) if $urlmapper;
	  }
	  undef $name unless $prp;
	}
	die("derived_from url not using obs:/ scheme: $derived\n") unless defined $name;
	push @packages, "container:$name";
	push @containerrepos, $prp if $prp;
      }

push @packages, "kiwi-filesystem:$type->{'filesystem'}" if $type->{'filesystem'};
      if (defined $type->{'boot'}) {
        if ($type->{'boot'} =~ /^obs:\/\/\/?([^\/]+)\/([^\/]+)\/?$/) {
          next unless $bootcallback;
          my ($bootxml, $xsrc) = $bootcallback->($1, $2);
          next unless $bootxml;
          push @extrasources, $xsrc if $xsrc;
          my $bret = kiwiparse($bootxml, $arch, $buildflavor, $release, $count);
	  if (defined($urlmapper) && !$urlmapper) {
            push @bootrepos, @{$bret->{'path'} || []};
	  } else {
            push @bootrepos, map {"$_->{'project'}/$_->{'repository'}"} @{$bret->{'path'} || []};
	  }
          push @packages, @{$bret->{'deps'} || []};
          push @extrasources, @{$bret->{'extrasource'} || []};
        } else {
          die("bad boot reference: $type->{'boot'}\n") unless $type->{'boot'} =~ /^([^\/]+)\/([^\/]+)$/;
          push @packages, "kiwi-boot:$1";
        }
      }
    }
  }

die("image contains 'product' type\n") if grep {$_ eq 'product'} @types;

my $packman = $preferences->[0]->{'packagemanager'}->[0]->{'_content'} || '';

# calculate priority for sorting
  for (@{$kiwi->{'repository'} || []}) {
    $_->{'sortprio'} = 0;
    if (defined($_->{'priority'})) {
      $_->{'sortprio'} = $packman eq 'smart' ? $_->{'priority'} : 99 - $_->{'priority'};
    }
  }

my @repositories = sort {$b->{'sortprio'} <=> $a->{'sortprio'}} @{$kiwi->{'repository'} || []};

my %repoprio;
  for my $repository (@repositories) {
    my $kiwisource = ($repository->{'source'} || [])->[0];
    next unless $kiwisource;	# huh?
    my $url = $kiwisource->{'path'};
    next if !$url || $url eq '/var/lib/empty';	# grr
    if ($repository->{'imageonly'} || $repository->{'imageinclude'}) {
      # this repo will be configured in the image. Save so that we can write it into the containerinfo
      push @imagerepos, { 'url' => $url };
      $imagerepos[-1]->{'priority'} = $repository->{'sortprio'} if defined $repository->{'priority'};
    }
    next if $repository->{'imageonly'};
    if (defined($urlmapper) && !$urlmapper) {
      # urlmapping disabled
      push @repos, { 'url' => $url };
      $repos[-1]->{'priority'} = $repository->{'sortprio'} if $repoextras && defined $repository->{'priority'};
      next;
    }
    my $prp;
    if ($url eq 'obsrepositories:/') {
      $prp = '_obsrepositories/';
    } elsif ($url =~ /^obs:\/{1,3}([^\/]+)\/([^\/]+)\/?$/) {
      $prp = "$1/$2";
    } else {
      $prp = $urlmapper->($url) if $urlmapper;
      die("repo url not using obs:/ scheme: $kiwisource->{'path'}\n") unless $prp;
    }
    push @repos, $prp;
    $repoprio{$prp} = $repository->{'sortprio'} if defined $repository->{'priority'};
  }

# Find packages for the image
  my @pkgs;
  my $patterntype;
  for my $packages (@{$kiwi->{'packages'}}) {
    next if $packages->{'type'} && $packages->{'type'} ne 'image' && $packages->{'type'} ne 'bootstrap';
    # we could skip the sections also when no profile is used,
    # but don't to stay backward compatible
    if ($obsprofiles && $packages->{'profiles'}) {
      my @section_profiles = split(",", $packages->{'profiles'});

next unless grep {$usedprofiles{$_}} @section_profiles;
    }

$patterntype ||= $packages->{'patternType'};
    push @pkgs, @{$packages->{'package'}} if $packages->{'package'};
    for my $pattern (@{$packages->{'namedCollection'} || []}) {
      push @pkgs, { %$pattern, 'name' => "pattern() = $pattern->{'name'}" } if $pattern->{'name'};
    }
    for my $product (@{$packages->{'product'} || []}) {
      push @pkgs, { %$product, 'name' => "product() = $product->{'name'}" } if $product->{'name'};
    }
    for my $pattern (@{$packages->{'opensusePatterns'} || []}) {
      push @pkgs, { %$pattern, 'name' => "pattern() = $pattern->{'name'}" } if $pattern->{'name'};
    }
    for my $product (@{$packages->{'opensuseProduct'} || []}) {
      push @pkgs, { %$product, 'name' => "product() = $product->{'name'}" } if $product->{'name'};
    }
  }
  $patterntype ||= 'onlyRequired';
  @pkgs = unify(@pkgs);
  for my $package (@pkgs) {
    # filter packages which are not targeted for the wanted plattform
    if ($package->{'arch'}) {
      my $valid;
      my $ma = $arch;
      $ma =~ s/i[456]86/i386/;
      for my $pa (split(",", $package->{'arch'})) {
        $pa =~ s/i[456]86/i386/;
        $valid = 1 if $ma eq $pa;
      }
      next unless $valid;
    }
    # handle replaces as buildignore
    push @packages, "-$package->{'replaces'}" if $package->{'replaces'};

# we need this package
    push @packages, $package->{'name'};
  }
  push @packages, map {"-$_"} @ignorepackages;
  push @packages, "kiwi-packagemanager:$packman" if $packman;
  push @packages, "--dorecommends--", "--dosupplements--" if $patterntype && $patterntype eq 'plusRecommended';
  push @packages, '--unorderedimagerepos', if $unorderedrepos;

$ret->{'exclarch'} = [ unify(split(' ', $obsexclusivearch)) ] if $obsexclusivearch;
  $ret->{'badarch'} = [ unify(split(' ', $obsexcludearch)) ] if $obsexcludearch;
  $ret->{'deps'} = [ unify(@packages) ];
  $ret->{'path'} = [ unify(@repos, @bootrepos) ];
  $ret->{'containerpath'} = [ unify(@containerrepos) ] if @containerrepos;
  $ret->{'imagetype'} = [ unify(@types) ];
  $ret->{'extrasource'} = \@extrasources if @extrasources;
  if (defined($urlmapper) && !$urlmapper) {
    $ret->{'path'} = [ unify_repo($ret->{'path'}) ] if @{$ret->{'path'} || []};
    $ret->{'containerpath'} = [ unify_repo($ret->{'containerpath'}) ] if @{$ret->{'containerpath'} || []};
  } else {
    for (@{$ret->{'path'} || []}) {
      my @s = split('/', $_, 2);
      $_ = {'project' => $s[0], 'repository' => $s[1]};
      $_->{'priority'} = $repoprio{"$s[0]/$s[1]"} if $repoextras && defined $repoprio{"$s[0]/$s[1]"};
    }
    for (@{$ret->{'containerpath'} || []}) {
      my @s = split('/', $_, 2);
      $_ = {'project' => $s[0], 'repository' => $s[1]};
    }
  }
  $ret->{'imagerepos'} = \@imagerepos if @imagerepos;
  if ($containerconfig) {
    my $containername = $containerconfig->{'name'};
    my @containertags;
    if (defined $containername) {
      push @containertags, $containerconfig->{'tag'} if defined $containerconfig->{'tag'};
      push @containertags, 'latest' unless @containertags;
      if (defined($containerconfig->{'additionaltags'})) {
	push @containertags, split(',', $containerconfig->{'additionaltags'});
      }
      @containertags = map {"$containername:$_"} @containertags;
    }
    push @containertags, @extratags if @extratags;
    $ret->{'container_tags'} = [ unify(@containertags) ] if @containertags;
  }
  if ($obsprofiles) {
    if (@$obsprofiles) {
      $ret->{'profiles'} = [ unify(@$obsprofiles) ];
    } else {
      $ret->{'exclarch'} = [];		# all profiles excluded
    }
  }
  return $ret;
}

sub parse {
  my ($cf, $fn) = @_;

local *F;
  open(F, '<', $fn) || die("$fn: $!\n");
  my $xml = '';
  1 while sysread(F, $xml, 4096, length($xml)) > 0;
  close F;
  $cf ||= {};
  my $d;
  eval { $d = kiwiparse($xml, ($cf->{'arch'} || ''), $cf->{'buildflavor'}, $cf->{'buildrelease'}, 0) };
  if ($@) {
    my $err = $@;
    chomp $err;
    return {'error' => $err};
  }
  return $d;
}

sub show {
  my ($fn, $field, $arch, $buildflavor) = @ARGV;
  local $urlmapper = sub { return $_[0] };
  my $cf = {'arch' => $arch};
  $cf->{'buildflavor'} = $buildflavor if defined $buildflavor;
  my $d = parse($cf, $fn);
  die("$d->{'error'}\n") if $d->{'error'};
  if ($field eq 'profiles' && $d->{'exclarch'} && !@{$d->{'exclarch'}}) {
    print "__excluded\n";
    return;
  }
  my $x = $d->{$field};
  $x = [ $x ] unless ref $x;
  if ($field eq 'copytoimage') {
    print "$_\n" for @$x;
  } else {
    print "@$x\n";
  }
}

sub showcontainerinfo {
  my ($disturl, $arch, $buildflavor, $release);
  while (@ARGV) {
    if (@ARGV > 2 && $ARGV[0] eq '--disturl') {
      (undef, $disturl) = splice(@ARGV, 0, 2);
    } elsif (@ARGV > 2 && $ARGV[0] eq '--arch') {
      (undef, $arch) = splice(@ARGV, 0, 2);
    } elsif (@ARGV > 2 && $ARGV[0] eq '--buildflavor') {
      (undef, $buildflavor) = splice(@ARGV, 0, 2);
    } elsif (@ARGV > 2 && $ARGV[0] eq '--release') {
      (undef, $release) = splice(@ARGV, 0, 2);
    } else {
      last;
    }
  }
  my ($fn, $image) = @ARGV;
  local $urlmapper = sub { return $_[0] };
  my $cf = {};
  $cf->{'arch'} = $arch if defined $arch;
  $cf->{'buildflavor'} = $buildflavor if defined $buildflavor;
  $cf->{'buildrelease'} = $release if defined $release;
  my $d = parse($cf, $fn);
  die("$d->{'error'}\n") if $d->{'error'};
  $image =~ s/.*\/// if defined $image;

my $profile;
  if (@{$d->{'profiles'} || []} > 1 && $image) {
    # try to figure out the used profile from the image name
    my @matches = grep {$image =~ /-\Q$_\E-/} @{$d->{'profiles'}};
    if (@matches) {
      $profile = $matches[0];
      # XXX: should re-parse with the correct profile now
    }
  }
  if (!defined($profile) && @{$d->{'profiles'} || []}) {
    $profile = $d->{'profiles'}->[0];
  }

my @repos;
  for my $repo (@{$d->{'imagerepos'} || []}) {
    push @repos, { 'url' => $repo->{'url'}, '_type' => {'priority' => 'number'} };
    $repos[-1]->{'priority'} = $repo->{'priority'} if defined $repo->{'priority'};
  }
  my $buildtime = time();
  my $containerinfo = {
    'name' => $d->{'name'},
    'buildtime' => $buildtime,
    '_type' => {'buildtime' => 'number'},
  };
  $containerinfo->{'name'} .= "-$profile" if !$d->{'donotappendprofiletocontainername'} && defined($profile) && $profile ne '';
  $containerinfo->{'version'} = $d->{'version'} if defined $d->{'version'};
  $containerinfo->{'release'} = $release if defined $release;
  $containerinfo->{'tags'} = $d->{'container_tags'} if @{$d->{'container_tags'} || []};
  $containerinfo->{'repos'} = \@repos if @repos;
  $containerinfo->{'file'} = $image if defined $image;
  $containerinfo->{'disturl'} = $disturl if defined $disturl;
  $containerinfo->{'milestone'} = $d->{'milestone'} if defined $d->{'milestone'};
  print Build::SimpleJSON::unparse($containerinfo)."\n";
}

# not implemented yet.
sub queryiso {
  my ($handle, %opts) = @_;
  return {};
}

sub queryhdrmd5 {
  my ($bin) = @_;
  die("Build::Kiwi::queryhdrmd5 unimplemented.\n");
}

1;
0707010000000e000081a400000000000000000000000163e504b900000b51000000000000000000000000000000000000001300000000Build/LiveBuild.pm################################################################
#
# Copyright (c) 2014 Brocade Communications Systems, Inc.
# Author: Jan Blunck <jblunck@infradead.org>
#
# This file is part of build.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
#################################################################

package Build::LiveBuild;

use strict;

eval { require Archive::Tar; };
*Archive::Tar::new = sub {die("Archive::Tar is not available\n")} unless defined &Archive::Tar::new;

sub filter {
  my ($content) = @_;

return '' unless defined $content;

$content =~ s/^#.*$//mg;
  $content =~ s/^!.*$//mg;
  $content =~ s/^\s*//mg;
  return $content;
}

sub parse_package_list {
  my ($content) = @_;
  my @packages = split /\n/, filter($content);

return @packages;
};

sub parse_archive {
  my ($content) = @_;
  my @repos;

my @lines = split /\n/, filter($content);
  for (@lines) {
    next if /^deb-src /;

die("bad path using not obs:/ URL: $_\n") unless $_ =~ /^deb\s+obs:\/\/\/?([^\s\/]+)\/([^\s\/]+)\/?\s+.*$/;
    push @repos, "$1/$2";
  }

return @repos;
}

sub unify {
  my %h = map {$_ => 1} @_;
  return grep(delete($h{$_}), @_);
}

sub parse {
  my ($config, $filename, @args) = @_;
  my $ret = {};

# check that filename is a tar
  my $tar = Archive::Tar->new;
  unless($tar->read($filename)) {
    warn("$filename: " . $tar->error . "\n");
    $ret->{'error'} = "$filename: " . $tar->error;
    return $ret;
  }

# check that directory layout matches live-build directory structure
  for my $file ($tar->list_files('')) {
    next unless $file =~ /^(.*\/)?config\/archives\/.*\.list.*/;
    warn("$filename: config/archives/*.list* files not allowed!\n");
    $ret->{'error'} = "$filename: config/archives/*.list* files not allowed!";
    return $ret;
  }

# always require the list of packages required by live-boot for
  # bootstrapping the target distribution image (e.g. with debootstrap)
  my @packages = ( 'live-build-desc' );

for my $file ($tar->list_files('')) {
    next unless $file =~ /^(.*\/)?config\/package-lists\/.*\.list.*/;
    push @packages, parse_package_list($tar->get_content($file));
  }

($ret->{'name'} = $filename) =~ s/\.[^.]+$//;
  $ret->{'deps'} = [ unify(@packages) ];
  return $ret;
}

1;
0707010000000f000081a400000000000000000000000163e504b900000e55000000000000000000000000000000000000001100000000Build/Mdkrepo.pm################################################################
#
# Copyright (c) 2015 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Mdkrepo;

use strict;
#use Data::Dumper;

sub addpkg {
  my ($res, $data, $options) = @_;
  if ($options->{'addselfprovides'} && defined($data->{'name'}) && defined($data->{'version'})) {
    if (($data->{'arch'} || '') ne 'src' && ($data->{'arch'} || '') ne 'nosrc') {
      my $evr = $data->{'version'};
      $evr = "$data->{'epoch'}:$evr" if $data->{'epoch'};
      $evr = "$evr-$data->{'release'}" if defined $data->{'release'};
      my $s = "$data->{'name'} = $evr";
      push @{$data->{'provides'}}, $s unless grep {$_ eq $s} @{$data->{'provides'} || []};
    }
  }
  if (ref($res) eq 'CODE') {
    $res->($data);
  } else {
    push @$res, $data;
  }

}

sub parsedeps {
  my ($d) = @_;
  my @d = split('@', $d);
  for (@d) {
    s/\[\*\]//s;
    s/\[(.*)\]$/ $1/s;
    s/ == / = /;
  }
  return \@d;
}

sub parse {
  my ($in, $res, %options) = @_;
  $res ||= [];
  my $fd;
  if (ref($in)) {
    $fd = $in;
  } else {
    if ($in =~ /\.[gc]z$/) {
      # we need to probe, as mageia uses xz for compression
      open($fd, '<', $in) || die("$in: $!\n");
      my $probe;
      sysread($fd, $probe, 5);
      close($fd);
      if ($probe && $probe eq "\xFD7zXZ") {
        open($fd, '-|', "xzdec", "-dc", $in) || die("$in: $!\n");
      } else {
        open($fd, '-|', "gzip", "-dc", $in) || die("$in: $!\n");
      }
    } else {
      open($fd, '<', $in) || die("$in: $!\n");
    }
  }
  my $s = {};
  while (<$fd>) {
    chomp;
    if (/^\@summary\@/) {
      $s->{'summary'} = substr($_, 9);
    } elsif (/^\@provides\@/) {
      $s->{'provides'} = parsedeps(substr($_, 10));
    } elsif (/^\@requires\@/) {
      $s->{'requires'} = parsedeps(substr($_, 10));
    } elsif (/^\@suggests\@/) {
      $s->{'suggests'} = parsedeps(substr($_, 10));
    } elsif (/^\@recommends\@/) {
      $s->{'recommends'} = parsedeps(substr($_, 12));
    } elsif (/^\@obsoletes\@/) {
      $s->{'obsoletes'} = parsedeps(substr($_, 11));
    } elsif (/^\@conflicts\@/) {
      $s->{'conflicts'} = parsedeps(substr($_, 11));
    } elsif (/^\@info\@/) {
      $s ||= {};
      my @s = split('@', substr($_, 6));
      $s->{'location'} = "$s[0].rpm";
      my $arch;
      if ($s[0] =~ /\.([^\.]+)$/) {
	$arch = $1;
	$s[0] =~ s/\.[^\.]+$//;
      }
      $s->{'epoch'} = $s[1] if $s[1];
      $s[0] =~ s/-\Q$s[4]\E[^-]*$//s if defined($s[4]) && $s[4] ne '';	# strip disttag
      $s[0] .= ":$s[5]" if defined($s[5]) && $s[5] ne '';	# add distepoch
      $s->{'arch'} = $arch || 'noarch';
      if ($s[0] =~ /^(.*)-([^-]+)-([^-]+)$/s) {
	($s->{'name'}, $s->{'version'}, $s->{'release'}) = ($1, $2, $3);
	# fake source entry for now...
	$s->{'source'} = $s->{'name'} if $s->{'arch'} ne 'src' && $s->{'arch'} ne 'nosrc';
        addpkg($res, $s, \%options);
      }
      $s = {};
    }
  }
  return $res;
}

07070100000010000081a400000000000000000000000163e504b90000092d000000000000000000000000000000000000000f00000000Build/Mkosi.pm#
# mkosi specific functions.
#
################################################################
#
# Copyright (c) 2022 Luca Boccassi <bluca@debian.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Mkosi;

use strict;

eval { require Config::IniFiles; };
*Config::IniFiles::new = sub {die("Config::IniFiles is not available\n")} unless defined &Config::IniFiles::new;

sub parse {
  my ($bconf, $fn) = @_;
  my $ret = {};
  my $file_content = "";

open my $fh, "<", $fn;
  unless($fn) {
    warn("Cannot open $fn\n");
    $ret->{'error'} = "Cannot open $fn\n";
    return $ret;
  }

# mkosi supports multi-value keys, separated by newlines, so we need to mangle the file
  # in order to make Config::IniFiles happy.
  # Remove the previous newline if the next line doesn't have a '=' or '[' character.
  while( my $line = <$fh>) {
    $line =~ s/#.*$//;
    if ((index $line, '=') == -1 && (index $line, '[') == -1) {
      chomp $file_content;
    }
    $file_content .= $line;
  }

close $fh;

my $cfg = Config::IniFiles->new( -file => \$file_content );
  unless($cfg) {
    warn("$fn: " . @Config::IniFiles::errors ? ":\n@Config::IniFiles::errors\n" : "\n");
    $ret->{'error'} = "$fn: " . @Config::IniFiles::errors ? ":\n@Config::IniFiles::errors\n" : "\n";
    return $ret;
  }

my @packages;
  if (length $cfg->val('Content', 'Packages')) {
    push(@packages, split /\s+/, $cfg->val('Content', 'Packages'));
  }
  if (length $cfg->val('Content', 'BuildPackages')) {
    push(@packages, split /\s+/, $cfg->val('Content', 'BuildPackages'));
  }

$ret->{'name'} = $fn;
  $ret->{'deps'} = \@packages;

return $ret;
}

1;
07070100000011000081a400000000000000000000000163e504b900000ca2000000000000000000000000000000000000001200000000Build/Modulemd.pm################################################################
#
# Copyright (c) 2021 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Modulemd;

use Build::SimpleYAML;

use strict;

# This module provides a modulemd data to yaml converter. It supports
# both the 'modulemd' and 'modulemd-defaults' formats.

my $mdtemplate = {
  '_order' => [ 'document', 'version', 'data' ],
  'version' => 'number',
  'data' => {
    '_order' => [ 'name', 'stream', 'version', 'context', 'arch', 'summary', 'description', 'servicelevels', 'license', 'xmd', 'dependencies', 'references', 'profiles', 'api', 'filter', 'buildopts', 'components', 'artifacts' ],
    'version' => 'number',
    'description' => 'folded',
    'license' => {
      '_order' => [ 'module', 'content' ],
    },
    'components' => {
      '_order' => [ 'rpms', 'modules' ],
      'rpms' => {
        '*' => {
          '_order' => [ 'rationale', 'name', 'repository', 'cache', 'ref', 'buildroot', 'srpm-buildroot', 'buildorder', 'buildafter', 'buildonly', 'arches', 'multilib' ],
          'buildroot' => 'bool',
          'srpm-buildroot' => 'bool',
          'buildorder' => 'number',
          'buildonly' => 'bool',
          'arches' => 'inline',
          'multilib' => 'inline',
        },
      },
      'modules' => {
        '*' => {
          '_order' => [ 'rationale', 'repository', 'ref', 'buildorder', 'buildafter', 'buildonly' ],
          'buildorder' => 'number',
          'buildonly' => 'bool',
        },
      },
    },
    'buildopts' => {
      '_order' => [ 'rpms', 'arches' ],
      'rpms' => {
        '_order' => [ 'macros', 'whitelist' ],
        'macros' => 'literal',
      },
      'arches' => 'inline',
    },
    'dependencies' => {
      'requires' => {
        '*' => 'inline',
      },
      'buildrequires' => {
        '*' => 'inline',
      },
    },
  },
};

my $mddefaultstemplate = {
  '_order' => [ 'document', 'version', 'data' ],
  'version' => 'number',
  'data' => {
    '_order' => [ 'module', 'modified', 'stream', 'profiles', 'intents' ],
    'modified' => 'number',
    'profiles' => {
      '*' => 'inline',
    },
    'intents' => {
      '*' => {
        '_order' => [ 'stream', 'profiles' ],
        'profiles' => {
          '*' => 'inline',
        },
      },
    },
  },
};

sub mdtoyaml {
  my ($md) = @_;
  my $template = $md && $md->{'document'} eq 'modulemd-defaults' ? $mddefaultstemplate : $mdtemplate;
  return Build::SimpleYAML::unparse($md, 'template' => $template);
}

1;
07070100000012000081a400000000000000000000000163e504b900000c39000000000000000000000000000000000000001100000000Build/Modules.pm################################################################
#
# Copyright (c) 2019 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Modules;

use strict;

eval { require YAML::XS; $YAML::XS::LoadBlessed = 0; };
*YAML::XS::LoadFile = sub {die("YAML::XS is not available\n")} unless defined &YAML::XS::LoadFile;

#
# return a hash that maps NEVRA to modules
#
sub parse {
  my ($in, $res, %options) = @_;

$res ||= {};
  # YAML::XS only alows a GLOB, so we need to do this old fashioned
  local *FD;
  my $fd;
  if (ref($in)) {
    *FD = $in;
  } else {
    if ($in =~ /\.gz$/) {
      open(FD, '-|', "gzip", "-dc", $in) || die("$in: $!\n");
    } else {
      open(FD, '<', $in) || die("$in: $!\n");
    }   
  }
  my %mods;
  my @mod = YAML::XS::LoadFile(\*FD);
  for my $mod (@mod) {
    next unless $mod->{'document'} eq 'modulemd';
    my $data = $mod->{'data'};
    next unless $data && ref($data) eq 'HASH';
    my $name = $data->{'name'};
    my $stream = $data->{'stream'};
    my $context = $data->{'context'};
    my $module = "$name-$stream";
    my @reqs;
    my $dependencies = $data->{'dependencies'};
    $dependencies = $dependencies->[0] if ref($dependencies) eq 'ARRAY';
    if ($dependencies && ref($dependencies) eq 'HASH') {
      my $requires = $dependencies->{'requires'};
      if ($requires && ref($requires) eq 'HASH') {
	for my $r (sort keys %$requires) {
	  my $rs = $requires->{$r};
	  $rs = $rs->[0] unless ref($rs) eq 'ARRAY';
	  if (@$rs) {
	    push @reqs, "$r-$rs->[0]";	# XXX: what about the rest?
	  } else {
	    push @reqs, $r;		# unversioned
	  }
	}
      }
    }
    my $moduleinfo = { 'name' => $module, 'stream' => $data->{'stream'} };
    $moduleinfo->{'context'} = $context if $context;
    $moduleinfo->{'requires'} = \@reqs if @reqs;
    $mods{"$module\@$context"} = $moduleinfo;
    next unless $data->{'artifacts'};
    my $rpms = $data->{'artifacts'}->{'rpms'};
    next unless $rpms && ref($rpms) eq 'ARRAY';
    for my $rpm (@$rpms) {
      my $nrpm = $rpm;
      $nrpm =~ s/-0:([^-]*-[^-]*\.[^\.]*)$/-$1/;	# normalize the epoch
      push @{$res->{$nrpm}}, $module;
      push @{$res->{$nrpm}}, "$module\@$context" if $context;
    }
  }
  # unify
  for (values %$res) {
    $_ = [ sort keys %{ { map {$_ => 1} @$_ } } ] if @$_ > 1;
  }
  # add moduleinfo
  $res->{'/moduleinfo'} = [ map {$mods{$_}} sort keys %mods ];
  return $res;
}

1;
07070100000013000081a400000000000000000000000163e504b900000922000000000000000000000000000000000000001100000000Build/Options.pm################################################################
#
# Copyright (c) 2021 SUSE LLC
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Options;

use strict;

sub getarg {
  my ($origopt, $args, $optional) = @_;
  return ${shift @$args} if @$args && ref($args->[0]);
  return shift @$args if @$args && $args->[0] !~ /^-/;
  die("Option $origopt needs an argument\n") unless $optional;
  return undef;
}

sub parse_options {
  my ($known_options, @args) = @_;
  my %opts;
  my @back;
  while (@args) {
    my $opt = shift @args;
    if ($opt !~ /^-/) {
      push @back, $opt;
      next;
    }
    if ($opt eq '--') {
      push @back, @args;
      last;
    }
    my $origopt = $opt;
    $opt =~ s/^--?//;
    unshift @args, \"$1" if $opt =~ s/=(.*)$//;
    my $ko = $known_options->{$opt};
    die("Unknown option '$origopt'. Exit.\n") unless defined $ko;
    $ko = "$opt$ko" if !ref($ko) && ($ko eq '' || $ko =~ /^:/);
    if (ref($ko)) {
      $ko->(\%opts, $opt, $origopt, \@args);
    } elsif ($ko =~ s/(:.*)//) {
      my $arg = getarg($origopt, \@args);
      if ($1 eq '::') {
        push @{$opts{$ko}}, $arg;
      } else {
        $opts{$ko} = $arg;
      }
    } else {
      my $arg = 1;
      if (@args && ref($args[0])) {
        $arg = getarg($origopt, \@args);
	$arg = 0 if $arg =~ /^(?:0|off|false|no)$/i;
	$arg = 1 if $arg =~ /^(?:1|on|true|yes)$/i;
	die("Bad boolean argument for option $origopt: '$arg'\n") unless $arg eq '0' || $arg eq '1';
      }
      $opts{$ko} = $arg;
    }
    die("Option $origopt does not take an argument\n") if @args && ref($args[0]);
  }

return (\%opts, @back);
}

1;
07070100000014000081a400000000000000000000000163e504b9000007da000000000000000000000000000000000000000e00000000Build/Repo.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Repo;

use strict;

our $do_rpmmd;
our $do_deb;
our $do_arch;
our $do_susetags;
our $do_mdk;

sub import {
  for (@_) {
    $do_rpmmd = 1 if $_ eq ':rpmmd';
    $do_deb = 1 if $_ eq ':deb';
    $do_arch = 1 if $_ eq ':arch';
    $do_susetags = 1 if $_ eq ':susetags';
    $do_mdk = 1 if $_ eq ':mdk';
  }
  $do_rpmmd = $do_deb = $do_arch = $do_susetags = $do_mdk = 1 unless $do_rpmmd || $do_deb || $do_arch || $do_susetags || $do_mdk;
  if ($do_rpmmd) {
    require Build::Rpmmd;
  }
  if ($do_susetags) {
    require Build::Susetags;
  }
  if ($do_deb) {
    require Build::Debrepo;
  }
  if ($do_arch) {
    require Build::Archrepo;
  }
  if ($do_mdk) {
    require Build::Mdkrepo;
  }
}

sub parse {
  my ($type, @args) = @_;
  return Build::Rpmmd::parse(@args) if $do_rpmmd && $type eq 'rpmmd';
  return Build::Susetags::parse(@args) if $do_susetags && $type eq 'susetags';
  return Build::Debrepo::parse(@args) if $do_deb && $type eq 'deb';
  return Build::Archrepo::parse(@args) if $do_arch && $type eq 'arch';
  return Build::Mdkrepo::parse(@args) if $do_arch && $type eq 'mdk';
  die("parse repo: unknown type '$type'\n");
}

1;
07070100000015000081a400000000000000000000000163e504b90000c8a5000000000000000000000000000000000000000d00000000Build/Rpm.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Rpm;

our $unfilteredprereqs = 0;
our $conflictdeps = 0;
our $includecallback;

use strict;

use Digest::MD5;

sub expr_boolify {
  my ($v) = @_;
  return !defined($v) || $v eq '"' || $v =~ /^(?:0*$|v)/s ? 0 : 1;
}

sub expr_vcmp {
  my ($v1, $v2, $rr) = @_;
  my $r = verscmp(substr($v1, 1), substr($v2, 1));
  return ($r < 0 ? 1 : $r > 0 ? 4 : 2) & $rr ? 1 : 0;
}

sub expr_dummyexpander {
  return substr($_[0], 0, 1);
}

sub expr_expand {
  my ($v, $expr, $xp, $r) = @_;
  while (1) {
    if ($expr =~ /^%%/s) {
      $v .= substr($expr, 0, 2, '');
    } elsif ($expr =~ /^%/s) {
      my $m = macroend($expr);
      $v .= substr($expr, 0, length($m), '');
    } elsif ($expr =~ /$r/) {
      $v .= substr($expr, 0, length($1), '');
    } else {
      return ($xp->($v), $expr);
    }
  }
}

sub expr {
  my ($expr, $lev, $xp) = @_;

$lev ||= 0;
  my ($v, $v2);
  $expr =~ s/^\s+//;
  my $t = substr($expr, 0, 1);
  if ($t eq '(') {
    ($v, $expr) = expr(substr($expr, 1), 0, $xp);
    return undef unless defined $v;
    return undef unless $expr =~ s/^\)//;
  } elsif ($t eq '!') {
    ($v, $expr) = expr(substr($expr, 1), 6, $xp);
    return undef unless defined $v;
    $v = expr_boolify($v) ? 0 : 1;
  } elsif ($t eq '-') {
    ($v, $expr) = expr(substr($expr, 1), 6, $xp);
    return undef unless defined $v;
    $v = -$v;
  } elsif ($expr =~ /^([0-9]+)(.*?)$/s || ($xp && $expr =~ /^(%)(.*)$/)) {
    $v = $1;
    $expr = $2;
    ($v, $expr) = expr_expand('0', "$1$2", $xp, qr/^([0-9]+)/) if $xp;
    $v = 0 + $v;
  } elsif ($expr =~ /^v\"(.*?)(\".*)$/s) {
    $v = "v$1";		# version
    $expr = $2;
    ($v, $expr) = expr_expand('v', substr("$1$2", 2), $xp, qr/^([^%\"]+)/) if $xp;
    $expr =~ s/^\"//s;
  } elsif ($expr =~ /^(\".*?)(\".*)$/s) {
    $v = $1;
    $expr = $2;
    ($v, $expr) = expr_expand('"', substr("$1$2", 1), $xp, qr/^([^%\"]+)/) if $xp;
    $expr =~ s/^\"//s;
  } elsif ($expr =~ /^([a-zA-Z][a-zA-Z_0-9]*)(.*)$/s) {
    # actually no longer supported with new rpm versions
    $v = "\"$1";
    $expr = $2;
  } else {
    return;
  }
  return ($v, $expr) if $lev >= 6;
  while (1) {
    $expr =~ s/^\s+//;
    if ($expr =~ /^&&/) {
      return ($v, $expr) if $lev >= 2;
      my $b = expr_boolify($v);
      ($v2, $expr) = expr(substr($expr, 2), 2, $xp && !$b ? \&expr_dummyexpander : $xp);
      return undef unless defined $v2;
      $v = $v2 if $b;
    } elsif ($expr =~ /^\|\|/) {
      return ($v, $expr) if $lev >= 2;
      my $b = expr_boolify($v);
      ($v2, $expr) = expr(substr($expr, 2), 2, $xp && $b ? \&expr_dummyexpander : $xp);
      return undef unless defined $v2;
      $v = $v2 unless $b;
    } elsif ($expr =~ /^>=/) {
      return ($v, $expr) if $lev >= 3;
      ($v2, $expr) = expr(substr($expr, 2), 3, $xp);
      return undef unless defined $v2;
      $v = (($v =~ /^v/) ? expr_vcmp($v, $v2, 6) : ($v =~ /^\"/) ? $v ge $v2 : $v >= $v2) ? 1 : 0;
    } elsif ($expr =~ /^>/) {
      return ($v, $expr) if $lev >= 3;
      ($v2, $expr) = expr(substr($expr, 1), 3, $xp);
      return undef unless defined $v2;
      $v = (($v =~ /^v/) ? expr_vcmp($v, $v2, 4) : ($v =~ /^\"/) ? $v gt $v2 : $v > $v2) ? 1 : 0;
    } elsif ($expr =~ /^<=/) {
      return ($v, $expr) if $lev >= 3;
      ($v2, $expr) = expr(substr($expr, 2), 3, $xp);
      return undef unless defined $v2;
      $v = (($v =~ /^v/) ? expr_vcmp($v, $v2, 3) : ($v =~ /^\"/) ? $v le $v2 : $v <= $v2) ? 1 : 0;
    } elsif ($expr =~ /^</) {
      return ($v, $expr) if $lev >= 3;
      ($v2, $expr) = expr(substr($expr, 1), 3, $xp);
      return undef unless defined $v2;
      $v = (($v =~ /^v/) ? expr_vcmp($v, $v2, 1) : ($v =~ /^\"/) ? $v lt $v2 : $v < $v2) ? 1 : 0;
    } elsif ($expr =~ /^==/) {
      return ($v, $expr) if $lev >= 3;
      ($v2, $expr) = expr(substr($expr, 2), 3, $xp);
      return undef unless defined $v2;
      $v = (($v =~ /^v/) ? expr_vcmp($v, $v2, 2) : ($v =~ /^\"/) ? $v eq $v2 : $v == $v2) ? 1 : 0;
    } elsif ($expr =~ /^!=/) {
      return ($v, $expr) if $lev >= 3;
      ($v2, $expr) = expr(substr($expr, 2), 3, $xp);
      return undef unless defined $v2;
      $v = (($v =~ /^v/) ? expr_vcmp($v, $v2, 5) : ($v =~ /^\"/) ? $v ne $v2 : $v != $v2) ? 1 : 0;
    } elsif ($expr =~ /^\+/) {
      return ($v, $expr) if $lev >= 4;
      ($v2, $expr) = expr(substr($expr, 1), 4, $xp);
      return undef unless defined $v2;
      if ($v =~ /^\"/ && $v2 =~ s/^\"//) {
	$v .= $v2;
      } else {
        $v += $v2;
      }
    } elsif ($expr =~ /^-/) {
      return ($v, $expr) if $lev >= 4;
      ($v2, $expr) = expr(substr($expr, 1), 4, $xp);
      return undef unless defined $v2;
      $v -= $v2;
    } elsif ($expr =~ /^\*/) {
      ($v2, $expr) = expr(substr($expr, 1), 5, $xp);
      return undef unless defined $v2;
      $v *= $v2;
    } elsif ($expr =~ /^\//) {
      ($v2, $expr) = expr(substr($expr, 1), 5, $xp);
      return undef unless defined $v2 && 0 + $v2;
      $v /= $v2;
    } elsif ($expr =~ /^\?/) {
      return ($v, $expr) if $lev > 1;
      my $b = expr_boolify($v);
      ($v, $expr) = expr(substr($expr, 1), 1, $xp && !$b ? \&expr_dummyexpander : $xp);
      warn("syntax error while parsing ternary in $_[0]\n") unless defined($v) && $expr =~ s/^://;
      ($v2, $expr) = expr($expr, 1, $xp && $b ? \&expr_dummyexpander : $xp);
      return undef unless defined $v2;
      $v = $v2 unless $b;
    } elsif ($expr =~ /^([=&|])/) {
      warn("syntax error while parsing $1$1\n");
      return ($v, $expr);
    } else {
      return ($v, $expr);
    }
  }
}

sub adaptmacros {
  my ($macros, $optold, $optnew) = @_;
  for (keys %$optold) {
    delete $macros->{$_};
  }
  for (keys %$optnew) {
    $macros->{$_} = $optnew->{$_};
  }
  return $optnew;
}

sub grabargs {
  my ($macname, $getopt, @args) = @_;
  my %m;
  $m{'0'} = $macname;
  $m{'**'} = join(' ', @args);
  my %go;
  %go = ($getopt =~ /(.)(:*)/sg) if defined $getopt;
  while (@args && $args[0] =~ s/^-//) {
    my $o = shift @args;
    last if $o eq '-';
    while ($o =~ /^(.)(.*)$/) {
      if ($go{$1}) {
	my $arg = $2;
	$arg = shift(@args) if @args && $arg eq '';
	$m{"-$1"} = "-$1 $arg";
	$m{"-$1*"} = $arg;
	last;
      }
      $m{"-$1"} = "-$1";
      $o = $2;
    }
  }
  $m{'#'} = scalar(@args);
  my $i = 1;
  for (@args) {
    $m{$i} = $_;
    $i++;
  }
  $m{'*'} = join(' ', @args);
  return \%m;
}

# no support for most special chars yet
sub luapattern {
  my ($pat) = @_;
  $pat = "\Q$pat\E";
  $pat =~ s/^\\\^/\^/;
  $pat =~ s/\\\$/\$/;
  $pat =~ s/\\\./\./;
  $pat =~ s/\\\*/\*/;
  $pat =~ s/\\\-/\*\?/;
  $pat =~ s/\\\?/\?/;
  $pat =~ s/\\\+/\+/;
  $pat =~ s/\\%([%ds])/\\$1/g;
  return $pat;
}

sub luamacro {
  my ($macname, @args) = @_;
  push @args, '' unless @args;
  return lc($args[0]) if $macname eq 'lower';
  return uc($args[0]) if $macname eq 'upper';
  return length($args[0]) if $macname eq 'len';
  return reverse($args[0]) if $macname eq 'reverse';
  return $args[0] x $args[1] if $macname eq 'rep';
  if ($macname eq 'sub') {
    push @args, 1 if @args < 2;
    push @args, -1 if @args < 3;
    $args[1] -= 1 if $args[1] > 0;
    $args[1] = length($args[0]) + $args[1] if $args[1] < 0;
    $args[1] = 0 if $args[1] < 0;
    $args[2] -= 1 if $args[2] > 0;
    $args[2] = length($args[0]) + $args[2] if $args[2] < 0;
    return $args[1] <= $args[2] ? substr($args[0], $args[1], $args[2] - $args[1] + 1) : '';
  }
  if ($macname eq 'gsub') {
    return unless @args >= 3;
    my $pat = luapattern($args[1]);
    my $rep = $args[3];
    eval {
      if (!defined($rep)) {
        $args[0] =~ s/$pat/$args[2]/g;
      } else {
        $args[0] =~ s/$pat(?(?{$rep--<=0})(*F))/$args[2]/g;
      }
    };
    return $@ ? '' : $args[0];
  }
  return '';
}

sub initmacros {
  my ($config, $macros, $macros_args) = @_;
  for my $line (@{$config->{'macros'} || []}) {
    next unless $line =~ /^%define\s*([0-9a-zA-Z_]+)(?:$([^$]*)\))?\s*(.*?)$/s;
    my $macname = $1;
    my $macargs = $2;
    my $macbody = $3;
    if (defined $macargs) {
      $macros_args->{$macname} = $macargs;
    } else {
      delete $macros_args->{$macname};
    }
    $macros->{$macname} = $macbody;
  }
}

sub macroend {
  my ($expr) = @_;
  if ($expr =~ /^%([\(\{\[])/s) {
    my $o = $1;
    my $c = $o eq '[' ? ']' : $o eq '(' ? ')' : '}';
    my $m = substr($expr, 0, 2, '');
    my $cnt = 1;
    my $r = qr/^(.*?)([$o$c\\])/s;
    while ($expr =~ /$r/) {
      $m .= substr($expr, 0, length($1) + 1, '');
      if ($2 eq '\\') {
	$m .= substr($expr, 0, 1, '');
      } elsif ($2 eq $o) {
	$cnt++;
      } elsif ($2 eq $c) {
	return $m if --$cnt == 0;
      }
    }
    return "$m$expr";
  }
  return $1 if $expr =~ /^(%[?!]*-?[a-zA-Z0-9_]*(?:\*|\*\*|\#)?)/s;
}

sub expandmacros {
  my ($config, $line, $lineno, $macros, $macros_args, $tries) = @_;

if (!$macros) {
    $macros = {};
    $macros_args = {};
    initmacros($config, $macros, $macros_args);
  }
  my $expandedline = '';
  $tries ||= 0;
  my @expandstack;
  my $optmacros = {};
  # newer perls: \{((?:(?>[^{}]+)|(?2))*)\}
reexpand:
  while ($line =~ /^(.*?)%(\{([^\}]+)\}|[\?\!]*[0-9a-zA-Z_]+|%|\*\*?|#|\(|\[)(.*?)\z/s) {
    if ($tries++ > 1000) {
      print STDERR "Warning: spec file parser ",($lineno?" line $lineno":''),": macro too deeply nested\n" if $config->{'warnings'};
      $line = 'MACRO';
      last;
    }
    $expandedline .= $1;
    $line = $4;
    if ($2 eq '%') {
      $expandedline .= '%';
      next;
    }
    my $macname = defined($3) ? $3 : $2;
    my $macorig = $2;
    my $macdata;
    my $macalt;
    if (defined($3)) {
      if ($macname =~ /[{\\]/) {	# tricky, use macroend
	$macname = macroend("%$macorig$line");
	$line = substr("%$macorig$line", length($macname));
        $macorig = substr($macname, 1);
	$macname =~ s/^%\{//s;
	$macname =~ s/\}\z//s;
      }
      $macdata = '';
      if ($macname =~ /^([^\s:]+)([\s:])(.*)\z/s) {
	$macname = $1;
	if ($2 eq ':') {
	  $macalt = $3;
	} else {
	  $macdata = $3;
	}
      }
    }
    my $mactest = 0;
    if ($macname =~ /^\!\?/s || $macname =~ /^\?\!/s) {
      $mactest = -1;
    } elsif ($macname =~ /^\?/s) {
      $mactest = 1;
    }
    $macname =~ s/^[\!\?]+//s;
    if ($macname eq '(') {
      print STDERR "Warning: spec file parser",($lineno?" line $lineno":''),": can't expand %(...)\n" if $config->{'warnings'};
      $line = 'MACRO';
      last;
    } elsif ($macname eq '[') {
      $macalt = macroend("%[$line");
      $line = substr($line, length($macalt) - 2);
      $macalt =~ s/^%\[//;
      $macalt =~ s/\]$//;
      my $xp = sub {expandmacros($config, $_[0], $lineno, $macros, $macros_args, $tries)};
      $macalt = (expr($macalt, 0, $xp))[0];
      $macalt =~ s/^[v\"]//;	# stringify
      $expandedline .= $macalt;
    } elsif ($macname eq 'define' || $macname eq 'global') {
      my $isglobal = $macname eq 'global' ? 1 : 0;
      if ($line =~ /^\s*([0-9a-zA-Z_]+)(?:$([^$]*)\))?\s*(.*?)$/) {
	my $macname = $1;
	my $macargs = $2;
	my $macbody = $3;
	$macbody = expandmacros($config, $macbody, $lineno, $macros, $macros_args, $tries) if $isglobal;
	if (defined $macargs) {
	  $macros_args->{$macname} = $macargs;
	} else {
	  delete $macros_args->{$macname};
	}
	$macros->{$macname} = $macbody;
      }
      $line = '';
      last;
    } elsif ($macname eq 'defined' || $macname eq 'with' || $macname eq 'undefined' || $macname eq 'without' || $macname eq 'bcond_with' || $macname eq 'bcond_without') {
      my @args;
      if ($macorig =~ /^\{(.*)\}$/) {
	@args = split(' ', $1);
	shift @args;
      } else {
	@args = split(' ', $line);
	$line = '';
      }
      next unless @args;
      if ($macname eq 'bcond_with') {
	$macros->{"with_$args[0]"} = 1 if exists $macros->{"_with_$args[0]"};
	next;
      }
      if ($macname eq 'bcond_without') {
	$macros->{"with_$args[0]"} = 1 unless exists $macros->{"_without_$args[0]"};
	next;
      }
      $args[0] = "with_$args[0]" if $macname eq 'with' || $macname eq 'without';
      $line = ((exists($macros->{$args[0]}) ? 1 : 0) ^ ($macname eq 'undefined' || $macname eq 'without' ? 1 : 0)).$line;
    } elsif ($macname eq 'expand') {
      $macalt = $macros->{$macname} unless defined $macalt;
      $macalt = '' if $mactest == -1;
      push @expandstack, ($expandedline, $line, undef);
      $line = $macalt;
      $expandedline = '';
    } elsif ($macname eq 'expr') {
      $macalt = $macros->{$macname} unless defined $macalt;
      $macalt = '' if $mactest == -1;
      $macalt = expandmacros($config, $macalt, $lineno, $macros, $macros_args, $tries);
      $macalt = (expr($macalt))[0];
      $macalt =~ s/^[v\"]//;	# stringify
      $expandedline .= $macalt;
    } elsif ($macname eq 'gsub' || $macname eq 'len' || $macname eq 'lower' || $macname eq 'upper' || $macname eq 'rep' || $macname eq 'reverse' || $macname eq 'sub') {
      my @args;
      if (defined $macalt) {
	push @args, $macalt;
      } elsif (defined $macdata)  {
	push @args, split(' ', $macdata);
      } else {
	$line =~ /^\s*([^\n]*).*$/;
	push @args, split(' ', $1);
	$line = '';
      }
      $_ = expandmacros($config, $_, $lineno, $macros, $macros_args, $tries) for @args;
      $expandedline .= luamacro($macname, @args);
    } elsif (exists($macros->{$macname})) {
      if (!defined($macros->{$macname})) {
	print STDERR "Warning: spec file parser",($lineno?" line $lineno":''),": can't expand '$macname'\n" if $config->{'warnings'};
	$line = 'MACRO';
	last;
      }
      if (defined($macros_args->{$macname})) {
	# macro with args!
	if (!defined($macdata)) {
	  $line =~ /^\s*([^\n]*).*$/;
	  $macdata = $1;
	  $line = '';
	}
	push @expandstack, ($expandedline, $line, $optmacros);
	$optmacros = adaptmacros($macros, $optmacros, grabargs($macname, $macros_args->{$macname}, split(' ', $macdata)));
	$line = $macros->{$macname};
	$expandedline = '';
	next;
      }
      $macalt = $macros->{$macname} unless defined $macalt;
      $macalt = '' if $mactest == -1;
      if ($macalt =~ /%/) {
	push @expandstack, ('', $line, 1) if $line ne '';
	$line = $macalt;
      } else {
	$expandedline .= $macalt;
      }
    } elsif ($mactest) {
      $macalt = '' if !defined($macalt) || $mactest == 1;
      if ($macalt =~ /%/) {
	push @expandstack, ('', $line, 1) if $line ne '';
	$line = $macalt;
      } else {
	$expandedline .= $macalt;
      }
    } else {
      $expandedline .= "%$macorig" unless $macname =~ /^-/;
    }
  }
  $line = $expandedline . $line;
  if (@expandstack) {
    my $m = pop(@expandstack);
    if ($m) {
      $optmacros = adaptmacros($macros, $optmacros, $m) if ref $m;
      $expandstack[-2] .= $line;
      $line = pop(@expandstack);
      $expandedline = pop(@expandstack);
    } else {
      my $todo = pop(@expandstack);
      $expandedline = pop(@expandstack);
      push @expandstack, ('', $todo, 1) if $todo ne '';
    }
    goto reexpand;
  }
  return $line;
}

sub splitexpansionresult {
  my ($line, $includelines) = @_;
  my @l = split("\n", $line);
  $line = shift @l;
  s/%/%%/g for @l;
  unshift @$includelines, @l;
  return $line;
}

# see rpm's copyNextLineFromOFI() function in build/parseSpec.c
sub needmorelines {
  my ($line) = @_;
  my ($bc, $pc, $xc, $nc) = (0, 0, 0, 0);
  while (1) {
    $line =~ s/^[^\\\n%\{\}\[\]]*//s;
    last if $line eq '';
    if ($line =~ s/^%\{//s) {
      $bc++;
    } elsif ($line =~ s/^%$//s) {
      $pc++;
    } elsif ($line =~ s/^%\[//s) {
      $xc++;
    } elsif ($line =~ s/^%%?//s) {
      next;
    } elsif ($line =~ s/^\n//s) {
      $nc = 0;
    } elsif ($line =~ s/^\\\n//s) {
      $nc = 1;
    } elsif ($line =~ s/^\\.?//s) {
      next;
    } elsif ($line =~ s/^([\{\}])//s) {
      $bc += $1 eq '{' ? 1 : -1 if $bc;
    } elsif ($line =~ s/^([\($])//s) {
      $pc += $1 eq '(' ? 1 : -1 if $pc;
    } elsif ($line =~ s/^([\[\]])//s) {
      $xc += $1 eq '[' ? 1 : -1 if $xc;
    }
  }
  return $pc || $bc || $xc || $nc ? 1 : 0;
}

sub splitdeps {
  my ($d) = @_;
  my @deps;
  $d =~ s/^[\s,]+//;
  while ($d ne '') {
    if ($d =~ /^\(/) {
      my @s = split(' ', $d);
      push @deps, shiftrich(\@s), undef, undef;
      $d = join(' ', @s);
    } else {
      last unless $d =~ s/([^\s\[,]+)(\s+[<=>]+\s+[^\s\[,]+)?(\s+\[[^\]]+\])?[\s,]*//;
      push @deps, $1, $2, $3;
    }
  }
  return @deps;
}

# xspec may be passed as array ref to return the parsed spec files
# an entry in the returned array can be
# - a string: verbatim line from the original file
# - a two element array ref:
#   - [0] original line
#   - [1] undef: line unused due to %if
#   - [1] scalar: line after macro expansion. Only set if it's a build deps
#                 line and build deps got modified or 'save_expanded' is set in
#                 config
sub parse {
  my ($config, $specfile, $xspec) = @_;

my $packname;
  my $exclarch;
  my $badarch;
  my @subpacks;
  my @packdeps;
  my @prereqs;
  my @alsonative;
  my @onlynative;
  my $hasnfb;
  my $nfbline;
  my %macros;
  my %macros_args;
  my $ret = {};
  my $ifdeps;
  my %autonum = (patch => 0, source => 0);

my $specdata;
  local *SPEC;
  if (ref($specfile) eq 'GLOB') {
    *SPEC = *$specfile;
  } elsif (ref($specfile) eq 'ARRAY') {
    $specdata = [ @$specfile ];
  } elsif (!open(SPEC, '<', $specfile)) {
    warn("$specfile: $!\n");
    $ret->{'error'} = "open $specfile: $!";
    return $ret;
  }
  
  initmacros($config, \%macros, \%macros_args);
  my $skip = 0;
  my $main_preamble = 1;
  my $preamble = 1;
  my $hasif = 0;
  my $lineno = 0;
  my @includelines;
  my $includenum = 0;
  my $obspackage = defined($config->{'obspackage'}) ? $config->{'obspackage'} : '@OBS_PACKAGE@';
  my $buildflavor = defined($config->{'buildflavor'}) ? $config->{'buildflavor'} : '';
  my $remoteasset;
  my $multilinedefine;
  my $multilinecondition;
  while (1) {
    my $line;
    my $doxspec = $xspec ? 1 : 0;
    if (@includelines) {
      $line = shift(@includelines);
      $includenum = 0 unless @includelines;
      $doxspec = 0;	# only record lines from main file
    } elsif ($specdata) {
      last unless @$specdata;
      $line = shift @$specdata;
      ++$lineno;
      if (ref $line) {
	$line = $line->[0]; # verbatim line, used for macro collection
	push @$xspec, $line if $doxspec;
	$xspec->[-1] = [ $line, undef ] if $doxspec && $skip;
	next;
      }
    } else {
      $line = <SPEC>;
      last unless defined $line;
      chomp $line;
      ++$lineno;
    }
    push @$xspec, $line if $doxspec;
    if ($line =~ /^#\s*neededforbuild\s*(\S.*)$/) {
      if (defined $hasnfb) {
	$xspec->[-1] = [ $xspec->[-1], undef ] if $doxspec;
	next;
      }
      $hasnfb = $1;
      $nfbline = \$xspec->[-1] if $doxspec;
      next;
    }
    if ($multilinedefine || $line =~ /^\s*%(?:define|global)\s/s) {
      # is this a multi-line macro definition?
      $line = "$multilinedefine\n$line" if defined $multilinedefine;
      undef $multilinedefine;
      if ($line =~ /\\\z/s) {
	$multilinedefine = $line;	# we need another line!
	next;
      }
    }
    if ($multilinecondition || $line =~ /^\s*\%\{[?!]*-?[0-9a-zA-Z_]+:\s*$/s) {
      # is this a multi-line macro condition?
      $line = "$multilinecondition\n$line" if defined $multilinecondition;
      undef $multilinecondition;
      if (needmorelines($line)) {
	$multilinecondition = $line;	# we need another line!
	next;
      }
    }
    if ($line =~ /^\s*#/) {
      next unless $line =~ /^#!/;
    }
    if (!$skip && ($line =~ /%/)) {
      $line = expandmacros($config, $line, $lineno, \%macros, \%macros_args);
      $line = splitexpansionresult($line, \@includelines) if $line =~ /\n/s;
    }
    if ($line =~ /^\s*%(?:elif|elifarch|elifos)\b/) {
      $skip = 1 if !$skip;
      $skip = 2 - $skip if $skip <= 2;
      next if $skip;
      $line =~ s/^(\s*%)el/$1/;
      $line = expandmacros($config, $line, $lineno, \%macros, \%macros_args);
      $line = splitexpansionresult($line, \@includelines) if $line =~ /\n/s;
    }
    if ($line =~ /^\s*%else\b/) {
      $skip = 2 - $skip if $skip <= 2;
      next;
    }
    if ($line =~ /^\s*%endif\b/) {
      $skip = $skip > 2 ? $skip - 2 : 0;
      next;
    }

if ($skip) {
      $skip += 2 if $line =~ /^\s*%if/;
      $xspec->[-1] = [ $xspec->[-1], undef ] if $doxspec;
      $ifdeps = 1 if $line =~ /^(BuildRequires|BuildPrereq|BuildConflicts|\#\!BuildIgnore|\#\!BuildConflicts|\#\!BuildRequires)\s*:\s*(\S.*)$/i;
      next;
    }

if ($line =~ /\@/) {
      $line =~ s/\@BUILD_FLAVOR\@/$buildflavor/g;
      $line =~ s/\@OBS_PACKAGE\@/$obspackage/g;
    }

if ($line =~ /^\s*%ifarch(.*)$/) {
      my $arch = $macros{'_target_cpu'} || 'unknown';
      my @archs = grep {$_ eq $arch} split(/\s+/, $1);
      $skip = 2 if !@archs;
      $hasif = 1;
      next;
    }
    if ($line =~ /^\s*%ifnarch(.*)$/) {
      my $arch = $macros{'_target_cpu'} || 'unknown';
      my @archs = grep {$_ eq $arch} split(/\s+/, $1);
      $skip = 2 if @archs;
      $hasif = 1;
      next;
    }
    if ($line =~ /^\s*%ifos(.*)$/) {
      my $os = $macros{'_target_os'} || 'unknown';
      my @oss = grep {$_ eq $os} split(/\s+/, $1);
      $skip = 2 if !@oss;
      $hasif = 1;
      next;
    }
    if ($line =~ /^\s*%ifnos(.*)$/) {
      my $os = $macros{'_target_os'} || 'unknown';
      my @oss = grep {$_ eq $os} split(/\s+/, $1);
      $skip = 2 if @oss;
      $hasif = 1;
      next;
    }
    if ($line =~ /^\s*%if(.*)$/) {
      my ($v, $r) = expr($1);
      $v = expr_boolify($v);
      $skip = 2 unless $v;
      $hasif = 1;
      next;
    }
    if ($includecallback && $line =~ /^\s*%include\s+(.*)\s*$/) {
      if ($includenum++ < 10) {
	my $data = $includecallback->($1);
	unshift @includelines, split("\n", $data) if $data;
      } else {
	warn("%include statment level too high, ignored\n") if $config->{'warnings'};
      }
    }
    if ($main_preamble) {
      if ($line =~ /^(Name|Epoch|Version|Release|Disttag)\s*:\s*(\S+)/i) {
	$ret->{lc $1} = $2;
	$macros{lc $1} = $2;
      } elsif ($line =~ /^ExclusiveArch\s*:\s*(.*)/i) {
	$exclarch ||= [];
	push @$exclarch, split(' ', $1);
      } elsif ($line =~ /^ExcludeArch\s*:\s*(.*)/i) {
	$badarch ||= [];
	push @$badarch, split(' ', $1);
      }
    }
    if (@subpacks && $preamble && exists($ret->{'version'}) && $line =~ /^Version\s*:\s*(\S+)/i) {
      $ret->{'multiversion'} = 1 if $ret->{'version'} ne $1;
    }
    if ($preamble && $line =~ /^\#\!ForceMultiVersion\s*$/i) {
      $ret->{'multiversion'} = 1;
    }
    if ($preamble && $line =~ /^\#\!NativeBuild\s*$/i) {
      $ret->{'nativebuild'} = 1;
    }
    if ($preamble && $line =~ /^\#\!RemoteAsset(?::\s*([a-z0-9]+:[0-9a-f]+))?\s*$/i) {
      $remoteasset = {};
      $remoteasset->{'digest'} = $1 if $1;
    }
    if ($preamble && $line =~ /^\#\!RemoteAssetUrl:\s*(\S+)\s*$/i) {
      $remoteasset->{'url'} = $1;
      push @{$ret->{'remoteassets'}}, $remoteasset;
      $remoteasset = undef;
    }
    if ($preamble && $line =~ /^\#\!BuildTarget:\s*(\S+)\s*$/i) {
      my $bt = $1;
      if ($bt =~ s/(.*?)://) {
	$bt = '' if $1 ne '' && $1 ne ($macros{'_target_cpu'} || 'unknown');
      }
      delete $ret->{'buildtarget'};
      $ret->{'buildtarget'} = $bt if $bt;
    }
    if ($preamble && $line =~ /^\#\!BuildConstraint:\s*(\S.+?)\s*$/i) {
      push @{$ret->{'buildconstraint'}}, $1;
    }
    if ($line =~ /^(?:Requires$pre$|Requires$post$|PreReq)\s*:\s*(\S.*)$/i) {
      my $deps = $1;
      my @deps;
      if (" $deps" =~ /[\s,]\(/) {
	@deps = splitdeps($deps);
      } else {
	@deps = $deps =~ /([^\s\[,]+)(\s+[<=>]+\s+[^\s\[,]+)?(\s+\[[^\]]+\])?[\s,]*/g;
      }
      while (@deps) {
	my ($pack, $vers, $qual) = splice(@deps, 0, 3);
	next if $pack eq 'MACRO';	# hope for the best...
	if (!$unfilteredprereqs && $pack =~ /^\//) {
	  $ifdeps = 1;
	  next unless $config->{'fileprovides'}->{$pack};
	}
	push @prereqs, $pack unless grep {$_ eq $pack} @prereqs;
      }
      next;
    }
    if ($preamble && ($line =~ /^(BuildRequires|BuildPrereq|BuildConflicts|\#\!BuildIgnore|\#\!BuildConflicts|\#\!BuildRequires|\#\!AlsoNative|\#\!OnlyNative)\s*:\s*(\S.*)$/i)) {
      my $what = $1;
      my $deps = $2;
      $ifdeps = 1 if $hasif;
      # XXX: weird syntax addition. can append arch or project to dependency
      # BuildRequire: foo > 17 [i586,x86_64]
      # BuildRequire: foo [home:bar]
      # BuildRequire: foo [!home:bar]
      my @deps;
      if (" $deps" =~ /[\s,]\(/) {
	# we need to be careful, there could be a rich dep
	@deps = splitdeps($deps);
      } else {
	@deps = $deps =~ /([^\s\[,]+)(\s+[<=>]+\s+[^\s\[,]+)?(\s+\[[^\]]+\])?[\s,]*/g;
      }
      my $replace = 0;
      my @ndeps = ();
      while (@deps) {
	my ($pack, $vers, $qual) = splice(@deps, 0, 3);
	if (defined($qual)) {
	  $replace = 1;
	  my $arch = $macros{'_target_cpu'} || '';
	  my $proj = $macros{'_target_project'} || '';
	  $qual =~ s/^\s*\[//;
	  $qual =~ s/\]$//;
	  my $isneg = 0;
	  my $bad;
	  for my $q (split('[\s,]', $qual)) {
	    $isneg = 1 if $q =~ s/^\!//;
	    $bad = 1 if !defined($bad) && !$isneg;
	    if ($isneg) {
	      if ($q eq $arch || $q eq $proj) {
		$bad = 1;
		last;
	      }
	    } elsif ($q eq $arch || $q eq $proj) {
	      $bad = 0;
	    }
	  }
	  next if $bad;
	}
	$vers = '' unless defined $vers;
	$vers =~ s/=(>|<)/$1=/;
	push @ndeps, "$pack$vers";
      }

$replace = 1 if grep {/^-/} @ndeps;
      my $lcwhat = lc($what);
      if ($lcwhat eq '#!alsonative') {
	push @alsonative, @ndeps;
	next;
      }
      if ($lcwhat eq '#!onlynative') {
	push @onlynative, @ndeps;
	next;
      }
      if ($lcwhat ne 'buildrequires' && $lcwhat ne 'buildprereq' && $lcwhat ne '#!buildrequires') {
        if ($conflictdeps && $what =~ /conflict/i) {
	  push @packdeps, map {"!$_"} @ndeps;
	  next;
	}
	push @packdeps, map {"-$_"} @ndeps;
	next;
      }
      if (defined($hasnfb)) {
	if ((grep {$_ eq 'glibc' || $_ eq 'rpm' || $_ eq 'gcc' || $_ eq 'bash'} @ndeps) > 2) {
	  # ignore old generated BuildRequire lines.
	  $xspec->[-1] = [ $xspec->[-1], undef ] if $doxspec;
	  next;
	}
      }
      push @packdeps, @ndeps;
      next unless $doxspec;
      if ($replace) {
	my @cndeps = grep {!/^-/} @ndeps;
	if (@cndeps) {
	  $xspec->[-1] = [ $xspec->[-1], "$what:  ".join(' ', @cndeps) ];
	} else {
	  $xspec->[-1] = [ $xspec->[-1], ''];
	}
      }
      next;
    } elsif ($preamble && $line =~ /^(Source\d*|Patch\d*|Url|Icon)\s*:\s*(\S+)/i) {
      my ($tag, $val) = (lc($1), $2);
      $macros{$tag} = $val if $tag eq 'url';
      # associate url and icon tags with the corresponding subpackage
      $tag .= scalar @subpacks if ($tag eq 'url' || $tag eq 'icon') && @subpacks;
      if ($tag =~ /icon/) {
        # there can be a gif and xpm icon
        push @{$ret->{$tag}}, $val;
      } else {
	if ($tag =~ /^(source|patch)(\d+)?$/) {
	  my $num = defined($2) ? 0 + $2 : $autonum{$1};
	  $tag = "$1$num";
	  if ($tag eq 'patch0' && exists($ret->{$tag})) {
	    # gross hack. Before autonumbering "Patch" and "Patch0" could
	    # exist. So take out the previous patch and add it back
	    # without number. This does not exactly work as old rpms
	    # but hopefully good enough :-)
	    $ret->{'patch'} = delete $ret->{$tag};
	  }
	  print STDERR "Warning: spec file parser: $tag already exists\n" if exists($ret->{$tag}) && $config->{'warnings'};
	  $autonum{$1} = $num + 1 if $num >= $autonum{$1};
	  $macros{uc($1) . "URL$num"} = $val;
	}
	$ret->{$tag} = $val;
      }
      if ($remoteasset && $tag =~ /^(?:source|patch)/) {
        $remoteasset->{'url'} = $val;
        push @{$ret->{'remoteassets'}}, $remoteasset;
      }
      $remoteasset = undef;
    } elsif (!$preamble && ($line =~ /^(Source\d*|Patch\d*|Url|Icon|BuildRequires|BuildPrereq|BuildConflicts|\#\!BuildIgnore|\#\!BuildConflicts|\#\!BuildRequires)\s*:\s*(\S.*)$/i)) {
      print STDERR "Warning: spec file parser ".($lineno ? " line $lineno" : '').": Ignoring $1 used beyond the preamble.\n" if $config->{'warnings'};
    }

if ($line =~ /^\s*%package\s+(-n\s+)?(\S+)/) {
      if ($1) {
	push @subpacks, $2;
      } else {
	push @subpacks, $ret->{'name'}.'-'.$2 if defined $ret->{'name'};
      }
      $preamble = 1;
      $main_preamble = 0;
    }

if ($line =~ /^\s*%(prep|build|install|check|clean|preun|postun|pretrans|posttrans|pre|post|files|changelog|description|triggerpostun|triggerun|triggerin|trigger|verifyscript)/) {
      $main_preamble = 0;
      $preamble = 0;
    }

# do this always?
    if ($doxspec && $config->{'save_expanded'}) {
      $xspec->[-1] = [ $xspec->[-1], $line ];
    }
  }
  close SPEC unless ref $specfile;
  if (defined($hasnfb)) {
    if (!@packdeps) {
      @packdeps = split(' ', $hasnfb);
    } elsif ($nfbline) {
      $$nfbline = [$$nfbline, undef ];
    }
  }
  unshift @subpacks, $ret->{'name'} if defined $ret->{'name'};
  $ret->{'subpacks'} = \@subpacks;
  $ret->{'exclarch'} = $exclarch if defined $exclarch;
  $ret->{'badarch'} = $badarch if defined $badarch;
  $ret->{'deps'} = \@packdeps;
  $ret->{'prereqs'} = \@prereqs if @prereqs;
  $ret->{'onlynative'} = \@onlynative if @onlynative;
  $ret->{'alsonative'} = \@alsonative if @alsonative;
  $ret->{'configdependent'} = 1 if $ifdeps;
  return $ret;
}

###########################################################################

my %rpmstag = (
  "SIGMD5"         => 261,
  "SIGTAG_SIZE"    => 1000,     # Header+Payload size in bytes. */
  "SIGTAG_PGP"     => 1002,     # RSA signature over Header+Payload
  "SIGTAG_MD5"     => 1004,     # MD5 hash over Header+Payload
  "SIGTAG_GPG"     => 1005,     # DSA signature over Header+Payload
  "NAME"           => 1000,
  "VERSION"        => 1001,
  "RELEASE"        => 1002,
  "EPOCH"          => 1003,
  "SUMMARY"        => 1004,
  "DESCRIPTION"    => 1005,
  "BUILDTIME"      => 1006,
  "VENDOR"         => 1011,
  "LICENSE"        => 1014,
  "ARCH"           => 1022,
  "OLDFILENAMES"   => 1027,
  "FILEMODES"      => 1030,
  "FILEDIGESTS"    => 1035,
  "SOURCERPM"      => 1044,
  "PROVIDENAME"    => 1047,
  "REQUIREFLAGS"   => 1048,
  "REQUIRENAME"    => 1049,
  "REQUIREVERSION" => 1050,
  "NOSOURCE"       => 1051,
  "NOPATCH"        => 1052,
  "EXCLUDEARCH"    => 1059,
  "EXCLUDEOS"      => 1060,
  "EXCLUSIVEARCH"  => 1061,
  "EXCLUSIVEOS"    => 1062,
  "SOURCEPACKAGE"  => 1106,
  "PROVIDEFLAGS"   => 1112,
  "PROVIDEVERSION" => 1113,
  "DIRINDEXES"     => 1116,
  "BASENAMES"      => 1117,
  "DIRNAMES"       => 1118,
  "DISTURL"        => 1123,
  "CONFLICTFLAGS"  => 1053,
  "CONFLICTNAME"   => 1054,
  "CONFLICTVERSION" => 1055,
  "OBSOLETENAME"   => 1090,
  "OBSOLETEFLAGS"  => 1114,
  "OBSOLETEVERSION" => 1115,
  "OLDSUGGESTSNAME" => 1156,
  "OLDSUGGESTSVERSION" => 1157,
  "OLDSUGGESTSFLAGS" => 1158,
  "OLDENHANCESNAME" => 1159,
  "OLDENHANCESVERSION" => 1160,
  "OLDENHANCESFLAGS" => 1161,
  "FILEDIGESTALGO" => 5011,
  "RECOMMENDNAME"  => 5046,
  "RECOMMENDVERSION" => 5047,
  "RECOMMENDFLAGS" => 5048,
  "SUGGESTNAME"    => 5049,
  "SUGGESTVERSION" => 5050,
  "SUGGESTFLAGS"   => 5051,
  "SUPPLEMENTNAME" => 5052,
  "SUPPLEMENTVERSION" => 5053,
  "SUPPLEMENTFLAGS" => 5054,
  "ENHANCENAME"    => 5055,
  "ENHANCEVERSION" => 5056,
  "ENHANCEFLAGS"   => 5057,
  "MODULARITYLABEL" => 5096,
);

sub rpmq {
  my ($rpm, @stags) = @_;

my @sigtags = grep {/^SIGTAG_/} @stags;
  @stags = grep {!/^SIGTAG_/} @stags;
  my $dosigs = @sigtags && !@stags;
  @stags = @sigtags if $dosigs;

my $need_filenames = grep { $_ eq 'FILENAMES' } @stags;
  push @stags, 'BASENAMES', 'DIRNAMES', 'DIRINDEXES', 'OLDFILENAMES' if $need_filenames;
  @stags = grep { $_ ne 'FILENAMES' } @stags if $need_filenames;

my %stags = map {0 + ($rpmstag{$_} || $_) => $_} @stags;

my ($magic, $sigtype, $headmagic, $cnt, $cntdata, $lead, $head, $index, $data, $tag, $type, $offset, $count);

local *RPM;
  my $forcebinary;
  if (ref($rpm) eq 'ARRAY') {
    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $rpm->[0]);
    if ($headmagic != 0x8eade801) {
      warn("Bad rpm\n");
      return ();
    }
    if (length($rpm->[0]) < 16 + $cnt * 16 + $cntdata) {
      warn("Bad rpm\n");
      return ();
    }
    $index = substr($rpm->[0], 16, $cnt * 16);
    $data = substr($rpm->[0], 16 + $cnt * 16, $cntdata);
  } else {
    if (ref($rpm) eq 'GLOB') {
      *RPM = *$rpm;
    } elsif (!open(RPM, '<', $rpm)) {
      warn("$rpm: $!\n");
      return ();
    }
    if (read(RPM, $lead, 96) != 96) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    ($magic, $sigtype) = unpack('N@78n', $lead);
    if ($magic != 0xedabeedb || $sigtype != 5) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    $forcebinary = 1 if unpack('@6n', $lead) != 1;
    if (read(RPM, $head, 16) != 16) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
    if ($headmagic != 0x8eade801) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    $cntdata = ($cntdata + 7) & ~7;
    if (read(RPM, $data, $cntdata) != $cntdata) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
  }

my %res = ();
  if (@sigtags && !$dosigs) {
    %res = &rpmq(["$head$index$data"], @sigtags);
  }
  if (ref($rpm) eq 'ARRAY' && !$dosigs && @$rpm > 1) {
    my %res2 = &rpmq([ $rpm->[1] ], @stags);
    %res = (%res, %res2);
    return %res;
  }
  if (ref($rpm) ne 'ARRAY' && !$dosigs) {
    if (read(RPM, $head, 16) != 16) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    ($headmagic, $cnt, $cntdata) = unpack('N@8NN', $head);
    if ($headmagic != 0x8eade801) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    if (read(RPM, $index, $cnt * 16) != $cnt * 16) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
    if (read(RPM, $data, $cntdata) != $cntdata) {
      warn("Bad rpm $rpm\n");
      close RPM unless ref($rpm);
      return ();
    }
  }
  close RPM unless ref($rpm);

#  return %res unless @stags;

while($cnt-- > 0) {
    ($tag, $type, $offset, $count, $index) = unpack('N4a*', $index);
    $tag = 0+$tag;
    if ($stags{$tag} || !@stags) {
      eval {
	my $otag = $stags{$tag} || $tag;
	if ($type == 0) {
	  $res{$otag} = [ '' ];
	} elsif ($type == 1) {
	  $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
	} elsif ($type == 2) {
	  $res{$otag} = [ unpack("\@${offset}c$count", $data) ];
	} elsif ($type == 3) {
	  $res{$otag} = [ unpack("\@${offset}n$count", $data) ];
	} elsif ($type == 4) {
	  $res{$otag} = [ unpack("\@${offset}N$count", $data) ];
	} elsif ($type == 5) {
	  $res{$otag} = [ undef ];
	} elsif ($type == 6) {
	  $res{$otag} = [ unpack("\@${offset}Z*", $data) ];
	} elsif ($type == 7) {
	  $res{$otag} = [ unpack("\@${offset}a$count", $data) ];
	} elsif ($type == 8 || $type == 9) {
	  my $d = unpack("\@${offset}a*", $data);
	  my @res = split("\0", $d, $count + 1);
	  $res{$otag} = [ splice @res, 0, $count ];
	} else {
	  $res{$otag} = [ undef ];
	}
      };
      if ($@) {
	warn("Bad rpm $rpm: $@\n");
	return ();
      }
    }
  }
  if ($forcebinary && $stags{1044} && !$res{$stags{1044}} && !($stags{1106} && $res{$stags{1106}})) {
    $res{$stags{1044}} = [ '(none)' ];	# like rpm does...
  }

if ($need_filenames) {
    if ($res{'OLDFILENAMES'}) {
      $res{'FILENAMES'} = [ @{$res{'OLDFILENAMES'}} ];
    } else {
      my $i = 0;
      $res{'FILENAMES'} = [ map {"$res{'DIRNAMES'}->[$res{'DIRINDEXES'}->[$i++]]$_"} @{$res{'BASENAMES'}} ];
    }
  }

return %res;
}

sub add_flagsvers {
  my ($res, $name, $flags, $vers) = @_;

return unless $res && $res->{$name};
  my @flags = @{$res->{$flags} || []};
  my @vers = @{$res->{$vers} || []};
  for (@{$res->{$name}}) {
    if (@flags && ($flags[0] & 0xe) && @vers) {
      $_ .= ' ';
      $_ .= '<' if $flags[0] & 2;
      $_ .= '>' if $flags[0] & 4;
      $_ .= '=' if $flags[0] & 8;
      $_ .= " $vers[0]";
    }
    shift @flags;
    shift @vers;
  }
}

sub filteroldweak {
  my ($res, $name, $flags, $data, $strong, $weak) = @_;

return unless $res && $res->{$name};
  my @flags = @{$res->{$flags} || []};
  my @strong;
  my @weak;
  for (@{$res->{$name}}) {
    if (@flags && ($flags[0] & 0x8000000)) {
      push @strong, $_;
    } else {
      push @weak, $_;
    }
    shift @flags;
  }
  $data->{$strong} = \@strong if @strong;
  $data->{$weak} = \@weak if @weak;
}

sub verscmp_part {
  my ($s1, $s2) = @_;
  if (!defined($s1)) {
    return defined($s2) ? -1 : 0;
  }
  return 1 if !defined $s2;
  return 0 if $s1 eq $s2;
  while (1) {
    $s1 =~ s/^[^a-zA-Z0-9~\^]+//;
    $s2 =~ s/^[^a-zA-Z0-9~\^]+//;
    if ($s1 =~ s/^~//) {
      next if $s2 =~ s/^~//;
      return -1;
    }
    return 1 if $s2 =~ /^~/;
    if ($s1 =~ s/^\^//) {
      next if $s2 =~ s/^\^//;
      return $s2 eq '' ? 1 : -1;
    }
    return $s1 eq '' ? -1 : 1 if $s2 =~ /^\^/;
    if ($s1 eq '') {
      return $s2 eq '' ? 0 : -1;
    }
    return 1 if $s2 eq '';
    my ($x1, $x2, $r);
    if ($s1 =~ /^([0-9]+)(.*?)$/) {
      $x1 = $1;
      $s1 = $2;
      $s2 =~ /^([0-9]*)(.*?)$/;
      $x2 = $1;
      $s2 = $2;
      return 1 if $x2 eq '';
      $x1 =~ s/^0+//;
      $x2 =~ s/^0+//;
      $r = length($x1) - length($x2) || $x1 cmp $x2;
    } elsif ($s1 ne '' && $s2 ne '') {
      $s1 =~ /^([a-zA-Z]*)(.*?)$/;
      $x1 = $1;
      $s1 = $2;
      $s2 =~ /^([a-zA-Z]*)(.*?)$/;
      $x2 = $1;
      $s2 = $2;
      return -1 if $x1 eq '' || $x2 eq '';
      $r = $x1 cmp $x2;
    }
    return $r > 0 ? 1 : -1 if $r;
  }
}

sub verscmp {
  my ($s1, $s2, $dtest) = @_;

return 0 if $s1 eq $s2;
  my ($e1, $v1, $r1) = $s1 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
  $e1 = 0 unless defined $e1;
  my ($e2, $v2, $r2) = $s2 =~ /^(?:(\d+):)?(.*?)(?:-([^-]*))?$/s;
  $e2 = 0 unless defined $e2;
  if ($e1 ne $e2) {
    my $r = verscmp_part($e1, $e2);
    return $r if $r;
  }
  return 0 if $dtest && ($v1 eq '' || $v2 eq '');
  if ($v1 ne $v2) {
    my $r = verscmp_part($v1, $v2);
    return $r if $r;
  }
  $r1 = '' unless defined $r1;
  $r2 = '' unless defined $r2;
  return 0 if $dtest && ($r1 eq '' || $r2 eq '');
  if ($r1 ne $r2) {
    return verscmp_part($r1, $r2);
  }
  return 0;
}

sub query {
  my ($handle, %opts) = @_;

my @tags = qw{NAME SOURCERPM NOSOURCE NOPATCH SIGTAG_MD5 PROVIDENAME PROVIDEFLAGS PROVIDEVERSION REQUIRENAME REQUIREFLAGS REQUIREVERSION SOURCEPACKAGE};
  push @tags, qw{EPOCH VERSION RELEASE ARCH};
  push @tags, qw{FILENAMES} if $opts{'filelist'};
  push @tags, qw{SUMMARY DESCRIPTION} if $opts{'description'};
  push @tags, qw{DISTURL} if $opts{'disturl'};
  push @tags, qw{BUILDTIME} if $opts{'buildtime'};
  push @tags, qw{LICENSE} if $opts{'license'};
  push @tags, qw{CONFLICTNAME CONFLICTVERSION CONFLICTFLAGS OBSOLETENAME OBSOLETEVERSION OBSOLETEFLAGS} if $opts{'conflicts'};
  push @tags, qw{RECOMMENDNAME RECOMMENDVERSION RECOMMENDFLAGS SUGGESTNAME SUGGESTVERSION SUGGESTFLAGS SUPPLEMENTNAME SUPPLEMENTVERSION SUPPLEMENTFLAGS ENHANCENAME ENHANCEVERSION ENHANCEFLAGS OLDSUGGESTSNAME OLDSUGGESTSVERSION OLDSUGGESTSFLAGS OLDENHANCESNAME OLDENHANCESVERSION OLDENHANCESFLAGS} if $opts{'weakdeps'};
  push @tags, qw{MODULARITYLABEL} if $opts{'modularitylabel'};
  push @tags, qw{EXCLUDEARCH EXCLUDEOS EXCLUSIVEARCH EXCLUSIVEOS} if $opts{'excludearch'};

my %res = rpmq($handle, @tags);
  return undef unless %res;
  my $src = $res{'SOURCERPM'}->[0];
  $res{'sourcerpm'} = $src if $src;
  $src = '' unless defined $src;
  $src =~ s/-[^-]*-[^-]*\.[^\.]*\.rpm//;
  add_flagsvers(\%res, 'PROVIDENAME', 'PROVIDEFLAGS', 'PROVIDEVERSION');
  add_flagsvers(\%res, 'REQUIRENAME', 'REQUIREFLAGS', 'REQUIREVERSION');
  my $data = {
    name => $res{'NAME'}->[0],
    hdrmd5 => unpack('H32', $res{'SIGTAG_MD5'}->[0]),
  };
  if ($opts{'alldeps'}) {
    $data->{'provides'} = [ @{$res{'PROVIDENAME'} || []} ];
    $data->{'requires'} = [ @{$res{'REQUIRENAME'} || []} ];
  } elsif ($opts{'filedeps'}) {
    $data->{'provides'} = [ grep {!/^rpmlib\(/} @{$res{'PROVIDENAME'} || []} ];
    $data->{'requires'} = [ grep {!/^rpmlib\(/} @{$res{'REQUIRENAME'} || []} ];
  } else {
    $data->{'provides'} = [ grep {!/^rpmlib\(/ && !/^\//} @{$res{'PROVIDENAME'} || []} ];
    $data->{'requires'} = [ grep {!/^rpmlib\(/ && !/^\//} @{$res{'REQUIRENAME'} || []} ];
  }
  if ($opts{'conflicts'}) {
    add_flagsvers(\%res, 'CONFLICTNAME', 'CONFLICTFLAGS', 'CONFLICTVERSION');
    add_flagsvers(\%res, 'OBSOLETENAME', 'OBSOLETEFLAGS', 'OBSOLETEVERSION');
    $data->{'conflicts'} = [ @{$res{'CONFLICTNAME'}} ] if $res{'CONFLICTNAME'};
    $data->{'obsoletes'} = [ @{$res{'OBSOLETENAME'}} ] if $res{'OBSOLETENAME'};
  }
  if ($opts{'weakdeps'}) {
    for (qw{RECOMMEND SUGGEST SUPPLEMENT ENHANCE}) {
      next unless $res{"${_}NAME"};
      add_flagsvers(\%res, "${_}NAME", "${_}FLAGS", "${_}VERSION");
      $data->{lc($_)."s"} = [ @{$res{"${_}NAME"}} ];
    }
    if ($res{'OLDSUGGESTSNAME'}) {
      add_flagsvers(\%res, 'OLDSUGGESTSNAME', 'OLDSUGGESTSFLAGS', 'OLDSUGGESTSVERSION');
      filteroldweak(\%res, 'OLDSUGGESTSNAME', 'OLDSUGGESTSFLAGS', $data, 'recommends', 'suggests');
    }
    if ($res{'OLDENHANCESNAME'}) {
      add_flagsvers(\%res, 'OLDENHANCESNAME', 'OLDENHANCESFLAGS', 'OLDENHANCESVERSION');
      filteroldweak(\%res, 'OLDENHANCESNAME', 'OLDENHANCESFLAGS', $data, 'supplements', 'enhances');
    }
  }

# rpm3 compatibility: retrofit missing self provides
  if ($src ne '') {
    my $haveselfprovides;
    if (@{$data->{'provides'}}) {
      if ($data->{'provides'}->[-1] =~ /^\Q$res{'NAME'}->[0]\E =/) {
	$haveselfprovides = 1;
      } elsif (@{$data->{'provides'}} > 1 && $data->{'provides'}->[-2] =~ /^\Q$res{'NAME'}->[0]\E =/) {
	$haveselfprovides = 1;
      }
    }
    if (!$haveselfprovides) {
      my $evr = "$res{'VERSION'}->[0]-$res{'RELEASE'}->[0]";
      $evr = "$res{'EPOCH'}->[0]:$evr" if $res{'EPOCH'} && $res{'EPOCH'}->[0];
      push @{$data->{'provides'}}, "$res{'NAME'}->[0] = $evr";
    }
  }

$data->{'source'} = $src eq '(none)' ? $data->{'name'} : $src if $src ne '';
  if ($opts{'evra'}) {
    my $arch = $res{'ARCH'}->[0];
    $arch = $res{'NOSOURCE'} || $res{'NOPATCH'} ? 'nosrc' : 'src' unless $src ne '';
    $data->{'version'} = $res{'VERSION'}->[0];
    $data->{'release'} = $res{'RELEASE'}->[0];
    $data->{'arch'} = $arch;
    $data->{'epoch'} = $res{'EPOCH'}->[0] if exists $res{'EPOCH'};
  }
  if ($opts{'filelist'}) {
    $data->{'filelist'} = $res{'FILENAMES'};
  }
  if ($opts{'description'}) {
    $data->{'summary'} = $res{'SUMMARY'}->[0];
    $data->{'description'} = $res{'DESCRIPTION'}->[0];
  }
  $data->{'buildtime'} = $res{'BUILDTIME'}->[0] if $opts{'buildtime'};
  $data->{'disturl'} = $res{'DISTURL'}->[0] if $opts{'disturl'} && $res{'DISTURL'};
  $data->{'license'} = $res{'LICENSE'}->[0] if $opts{'license'} && $res{'LICENSE'};
  $data->{'modularitylabel'} = $res{'MODULARITYLABEL'}->[0] if $opts{'modularitylabel'} && $res{'MODULARITYLABEL'};
  if ($opts{'excludearch'}) {
    for (qw{EXCLUDEARCH EXCLUDEOS EXCLUSIVEARCH EXCLUSIVEOS}) {
      $data->{lc($_)} = $res{$_} if @{$res{$_} || []};
    }
  }
  return $data;
}

sub queryhdrmd5 {
  my ($bin, $leadsigp) = @_;

local *F;
  open(F, '<', $bin) || die("$bin: $!\n");
  my $buf = '';
  my $l;
  while (length($buf) < 96 + 16) {
    $l = sysread(F, $buf, 4096, length($buf));
    if (!$l) {
      warn("$bin: read error\n");
      close(F);
      return undef;
    }
  }
  my ($magic, $sigtype) = unpack('N@78n', $buf);
  if ($magic != 0xedabeedb || $sigtype != 5) {
    warn("$bin: not a rpm (bad magic of header type)\n");
    close(F);
    return undef;
  }
  my ($headmagic, $cnt, $cntdata) = unpack('@96N@104NN', $buf);
  if ($headmagic != 0x8eade801) {
    warn("$bin: not a rpm (bad sig header magic)\n");
    close(F);
    return undef;
  }
  my $hlen = 96 + 16 + $cnt * 16 + $cntdata;
  $hlen = ($hlen + 7) & ~7;
  while (length($buf) < $hlen) {
    $l = sysread(F, $buf, 4096, length($buf));
    if (!$l) {
      warn("$bin: read error\n");
      close(F);
      return undef;
    }
  }
  close F;
  $$leadsigp = Digest::MD5::md5_hex(substr($buf, 0, $hlen)) if $leadsigp;
  my $idxarea = substr($buf, 96 + 16, $cnt * 16);
  if ($idxarea !~ /\A(?:.{16})*\000\000\003\354\000\000\000\007(....)\000\000\000\020/s) {
    warn("$bin: no md5 signature header\n");
    return undef;
  }
  my $md5off = unpack('N', $1);
  if ($md5off >= $cntdata) {
    warn("$bin: bad md5 offset\n");
    return undef;
  }
  $md5off += 96 + 16 + $cnt * 16;
  return unpack("\@${md5off}H32", $buf);
}

sub queryinstalled {
  my ($root, %opts) = @_;

$root = '' if !defined($root) || $root eq '/';
  local *F;
  my $dochroot = $root ne '' && !$opts{'nochroot'} && !$< && (-x "$root/usr/bin/rpm" || -x "$root/bin/rpm") ? 1 : 0;
  my $pid = open(F, '-|');
  die("fork: $!\n") unless defined $pid;
  if (!$pid) {
    if ($dochroot && chroot($root)) {
      chdir('/') || die("chdir: $!\n");
      $root = '';
    }
    my @args;
    unshift @args, '--nodigest', '--nosignature' if -e "$root/usr/bin/rpmquery ";
    unshift @args, '--dbpath', "$root/var/lib/rpm" if $root ne '';
    push @args, '--qf', '%{NAME}/%{ARCH}/%|EPOCH?{%{EPOCH}}:{0}|/%{VERSION}/%{RELEASE}/%{BUILDTIME}\n';
    if (-x "$root/usr/bin/rpm") {
      exec("$root/usr/bin/rpm", '-qa', @args);
      die("$root/usr/bin/rpm: $!\n");
    }
    if (-x "$root/bin/rpm") {
      exec("$root/bin/rpm", '-qa', @args);
      die("$root/bin/rpm: $!\n");
    }
    die("rpm: command not found\n");
  }
  my @pkgs;
  while (<F>) {
    chomp;
    my @s = split('/', $_);
    next unless @s >= 5;
    my $q = {'name' => $s[0], 'arch' => $s[1], 'version' => $s[3], 'release' => $s[4]};
    $q->{'epoch'} = $s[2] if $s[2];
    $q->{'buildtime'} = $s[5] if $s[5];
    push @pkgs, $q;
  }
  if (!close(F)) {
    return queryinstalled($root, %opts, 'nochroot' => 1) if !@pkgs && $dochroot;
    die("rpm: exit status $?\n");
  }
  return \@pkgs;
}

# return (lead, sighdr, hdr [, hdrmd5]) of a rpm
sub getrpmheaders {
  my ($path, $withhdrmd5) = @_;

my $hdrmd5;
  local *F;
  open(F, '<', $path) || die("$path: $!\n");
  my $buf = '';
  my $l;
  while (length($buf) < 96 + 16) {
    $l = sysread(F, $buf, 4096, length($buf));
    die("$path: read error\n") unless $l;
  }
  die("$path: not a rpm\n") unless unpack('N', $buf) == 0xedabeedb && unpack('@78n', $buf) == 5;
  my ($headmagic, $cnt, $cntdata) = unpack('@96N@104NN', $buf);
  die("$path: not a rpm (bad sig header)\n") unless $headmagic == 0x8eade801 && $cnt < 16384 && $cntdata < 1048576;
  my $hlen = 96 + 16 + $cnt * 16 + $cntdata;
  $hlen = ($hlen + 7) & ~7;
  while (length($buf) < $hlen + 16) {
    $l = sysread(F, $buf, 4096, length($buf));
    die("$path: read error\n") unless $l;
  }
  if ($withhdrmd5) {
    my $idxarea = substr($buf, 96 + 16, $cnt * 16);
    die("$path: no md5 signature header\n") unless $idxarea =~ /\A(?:.{16})*\000\000\003\354\000\000\000\007(....)\000\000\000\020/s;
    my $md5off = unpack('N', $1);
    die("$path: bad md5 offset\n") unless $md5off;
    $md5off += 96 + 16 + $cnt * 16; 
    $hdrmd5 = unpack("\@${md5off}H32", $buf);
  }
  ($headmagic, $cnt, $cntdata) = unpack('N@8NN', substr($buf, $hlen));
  die("$path: not a rpm (bad header)\n") unless $headmagic == 0x8eade801 && $cnt < 1048576 && $cntdata < 33554432;
  my $hlen2 = $hlen + 16 + $cnt * 16 + $cntdata;
  while (length($buf) < $hlen2) {
    $l = sysread(F, $buf, 4096, length($buf));
    die("$path: read error\n") unless $l;
  }
  close F;
  return (substr($buf, 0, 96), substr($buf, 96, $hlen - 96), substr($buf, $hlen, $hlen2 - $hlen), $hdrmd5);
}

sub getnevr_rich {
  my ($d) = @_;
  my $n = '';
  my $bl = 0;
  while ($d =~ /^([^ ,]*)/) {
    $n .= $1;
    $d = substr($d, length($1));
    last unless $d =~ /^([])/;
    $bl += $1 eq '(' ? 1 : -1;
    last if $bl < 0;
    $n .= $1;
    $d = substr($d, 1);
  }
  return $n;
}

my %richops  = (
  'and'     => 1,
  'or'      => 2,
  'if'      => 3,
  'unless'  => 4,
  'else'    => 5,
  'with'    => 6,
  'without' => 7,
);

sub parse_rich_rec {
  my ($dep, $chainop) = @_;
  my $d = $dep;
  $chainop ||= 0;
  return ($d, undef) unless $d =~ s/^$\s*//;
  my ($r, $r2);
  if ($d =~ /^\(/) {
    ($d, $r) = parse_rich_rec($d);
    return ($d, undef) unless $r;
  } else {
    return ($d, undef) if $d =~ /^$/;
    my $n = getnevr_rich($d);
    $d = substr($d, length($n));
    $d =~ s/^ +//;
    if ($d =~ /^([<=>]+)/) {
      $n .= " $1 ";
      $d =~ s/^[<=>]+ +//;
      my $evr = getnevr_rich($d);
      $d = substr($d, length($evr));
      $n .= $evr;
    }
    $r = [0, $n];
  }
  $d =~ s/^\s+//;
  return ($d, undef) unless $d ne '';
  return ($d, $r) if $d =~ s/^\)//;
  return ($d, undef) unless $d =~ s/([a-z]+)\s+//;
  my $op = $richops {$1};
  return ($d, undef) unless $op;
  return ($d, undef) if $op == 5 && $chainop != 3 && $chainop != 4;
  $chainop = 0 if $op == 5;
  return ($d, undef) if $chainop && (($chainop != 1 && $chainop != 2 && $chainop != 6) || $op != $chainop);
  ($d, $r2) = parse_rich_rec("($d", $op);
  return ($d, undef) unless $r2;
  if (($op == 3 || $op == 4) && $r2->[0] == 5) {
    $r = [$op, $r, $r2->[1], $r2->[2]];
  } else {
    $r = [$op, $r, $r2];
  }
  return ($d, $r);
}

sub parse_rich_dep {
  my ($dep) = @_;
  my ($d, $r) = parse_rich_rec($dep);
  return undef if !$r || $d ne '';
  return $r;
}

my @testcaseops = ('', '&', '|', '<IF>', '<UNLESS>', '<ELSE>', '+', '-');

sub testcaseformat_rec {
  my ($r, $addparens) = @_;
  my $op = $r->[0];
  return $r->[1] unless $op;
  my $top = $testcaseops[$op];
  my $r1 = testcaseformat_rec($r->[1], 1);
  if (($op == 3 || $op == 4) && @$r == 4) {
    $r1 = "$r1 $top " . testcaseformat_rec($r->[2], 1);
    $top = '<ELSE>';
  }
  my $addparens2 = 1;
  $addparens2 = 0 if $r->[2]->[0] == $op && ($op == 1 || $op == 2 || $op == 6);
  my $r2 = testcaseformat_rec($r->[-1], $addparens2);
  return $addparens ? "($r1 $top $r2)" : "$r1 $top $r2";
}

sub testcaseformat {
  my ($dep) = @_;
  my $r = parse_rich_dep($dep);
  return $dep unless $r;
  return testcaseformat_rec($r);
}

sub shiftrich {
  my ($s) = @_;
  # FIXME: do this right!
  my $dep = shift @$s;
  while (@$s && ($dep =~ y/$/\(/) > ($dep =~ y/$/\)/)) {
    $dep .= ' ' . shift(@$s);
  }
  return $dep;
}

1;
07070100000016000081a400000000000000000000000163e504b900001ec8000000000000000000000000000000000000000f00000000Build/Rpmmd.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Rpmmd;

use strict;

use Build::Rpm;

use XML::Parser;

sub generic_parse {
  my ($how, $in, $res, %options) = @_;
  $res ||= [];
  my @cursor = ([undef, $how, undef, $res, undef, \%options]);
  my $p = new XML::Parser(Handlers => {
    Start => sub {
      my ($p, $el) = @_;
      my $h = $cursor[-1]->[1];
      return unless exists $h->{$el};
      $h = $h->{$el};
      push @cursor, [$el, $h];
      $cursor[-1]->[2] = '' if $h->{'_text'};
      $h->{'_start'}->($h, \@cursor, @_) if exists $h->{'_start'};
    },
    End => sub {
      my ($p, $el) = @_;
      if ($cursor[-1]->[0] eq $el) {
	my $h = $cursor[-1]->[1];
	$h->{'_end'}->($h, \@cursor, @_) if exists $h->{'_end'};
	pop @cursor;
      }
    },
    Char => sub {
      my ($p, $text) = @_;
      $cursor[-1]->[2] .= $text if defined $cursor[-1]->[2];
    },
    ExternEnt => sub { undef },
  }, ErrorContext => 2);
  if (ref($in)) {
    $p->parse($in);
  } else {
    $p->parsefile($in);
  }
  return $res;
}

sub generic_store_text {
  my ($h, $c, $p, $el) = @_;
  my $data = $c->[0]->[4];
  $data->{$h->{'_tag'}} = $c->[-1]->[2] if defined $c->[-1]->[2];
}

sub generic_store_attr {
  my ($h, $c, $p, $el, %attr) = @_;
  my $data = $c->[0]->[4];
  $data->{$h->{'_tag'}} = $attr{$h->{'_attr'}} if defined $attr{$h->{'_attr'}};
}

sub generic_new_data {
  my ($h, $c, $p, $el, %attr) = @_;
  $c->[0]->[4] = {};
  generic_store_attr(@_) if $h->{'_attr'};
}

sub generic_add_result {
  my ($h, $c, $p, $el) = @_;
  my $data = $c->[0]->[4];
  return unless $data;
  my $res = $c->[0]->[3];
  if (ref($res) eq 'CODE') {
    $res->($data);
  } else {
    push @$res, $data;
  }
  undef $c->[0]->[4];
}

my $repomdparser = {
  repomd => {
    data => {
      _start => \&generic_new_data,
      _attr => 'type',
      _tag => 'type',
      _end => \&generic_add_result,
      location => { _start => \&generic_store_attr, _attr => 'href', _tag => 'location'},
      checksum => { _start => \&generic_store_attr, _attr => 'type', _tag => 'checksum', _text => 1, _end => \&primary_handle_checksum },
      size => { _text => 1, _end => \&generic_store_text, _tag => 'size'},
    },
  },
};

my $primaryparser = {
  metadata => {
    'package' => {
      _start => \&generic_new_data,
      _attr => 'type',
      _tag => 'type',
      _end => \&primary_add_result,
      name => { _text => 1, _end => \&generic_store_text, _tag => 'name' },
      arch => { _text => 1, _end => \&generic_store_text, _tag => 'arch' },
      version => { _start => \&primary_handle_version },
      checksum => { _start => \&generic_store_attr, _attr => 'type', _tag => 'checksum', _text => 1, _end => \&primary_handle_checksum },
      'time' => { _start => \&primary_handle_time },
      format => {
        'rpm:provides' =>    { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'provides' }, },
        'rpm:requires' =>    { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'requires' }, },
        'rpm:conflicts' =>   { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'conflicts' }, },
        'rpm:recommends' =>  { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'recommends' }, },
        'rpm:suggests' =>    { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'suggests' }, },
        'rpm:supplements' => { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'supplements' }, },
        'rpm:enhances' =>    { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'enhances' }, },
        'rpm:obsoletes' =>   { 'rpm:entry' => { _start => \&primary_handle_dep , _tag => 'obsoletes' }, },
        'rpm:buildhost' => { _text => 1, _end => \&generic_store_text, _tag => 'buildhost' },
        'rpm:vendor' => { _text => 1, _end => \&generic_store_text, _tag => 'vendor' },
        'rpm:license' => { _text => 1, _end => \&generic_store_text, _tag => 'license' },
        'rpm:sourcerpm' => { _text => 1, _end => \&primary_handle_sourcerpm , _tag => 'source' },
### currently commented out, as we ignore file provides in expanddeps
#       file => { _text => 1, _end => \&primary_handle_file_end, _tag => 'provides' },
      },
      location => { _start => \&generic_store_attr, _attr => 'href', _tag => 'location'},
    },
  },
};

sub primary_handle_sourcerpm {
  my ($h, $c, $p, $el, %attr) = @_;
  my $data = $c->[0]->[4];
  return unless defined $c->[-1]->[2];
  $data->{'sourcerpm'} = $data->{'source'} = $c->[-1]->[2];
  $data->{'source'} =~ s/-[^-]*-[^-]*\.[^\.]*\.rpm$//;
}

sub primary_handle_version {
  my ($h, $c, $p, $el, %attr) = @_;
  my $data = $c->[0]->[4];
  $data->{'epoch'} = $attr{'epoch'} if $attr{'epoch'};
  $data->{'version'} = $attr{'ver'};
  $data->{'release'} = $attr{'rel'};
}

sub primary_handle_time {
  my ($h, $c, $p, $el, %attr) = @_;
  my $data = $c->[0]->[4];
  $data->{'filetime'} = $attr{'file'} if $attr{'file'};
  $data->{'buildtime'} = $attr{'build'} if $attr{'build'};
}

sub primary_handle_checksum {
  my ($h, $c, $p, $el) = @_;
  my $data = $c->[0]->[4];
  my $type = lc(delete($data->{$h->{'_tag'}}) || '');
  $type = 'sha1' if $type eq 'sha';
  if ($type eq 'md5' || $type eq 'sha1' || $type eq 'sha256' || $type eq 'sha512') {
    $data->{$h->{'_tag'}} = "$type:$c->[-1]->[2]" if defined $c->[-1]->[2];
  }
}

sub primary_handle_file_end {
  my ($h, $c, $p, $el) = @_;
  primary_handle_dep($h, $c, $p, $el, 'name', $c->[-1]->[2]);
}

my %flagmap = ( EQ => '=', LE => '<=', GE => '>=', GT => '>', LT => '<', NE => '!=' );

sub primary_handle_dep {
  my ($h, $c, $p, $el, %attr) = @_;
  my $dep = $attr{'name'};
  return if $dep =~ /^rpmlib\(/;
  if(exists $attr{'flags'}) {
    my $evr = $attr{'ver'};
    return unless defined($evr) && exists($flagmap{$attr{'flags'}});
    $evr = "$attr{'epoch'}:$evr" if $attr{'epoch'};
    $evr .= "-$attr{'rel'}" if defined $attr{'rel'};
    $dep .= " $flagmap{$attr{'flags'}} $evr";
  }
  $dep = Build::Rpm::testcaseformat($dep) if ($dep =~ /^\(/) && ($c->[0]->[5] || {})->{'testcaseformat'};
  my $data = $c->[0]->[4];
  push @{$data->{$h->{'_tag'}}}, $dep;
}

sub primary_add_result {
  my ($h, $c, $p, $el) = @_;
  my $options = $c->[0]->[5] || {};
  my $data = $c->[0]->[4];
  if ($options->{'addselfprovides'} && defined($data->{'name'}) && defined($data->{'version'})) {
    if (($data->{'arch'} || '') ne 'src' && ($data->{'arch'} || '') ne 'nosrc') {
      my $evr = $data->{'version'};
      $evr = "$data->{'epoch'}:$evr" if $data->{'epoch'};
      $evr = "$evr-$data->{'release'}" if defined $data->{'release'};
      my $s = "$data->{'name'} = $evr";
      push @{$data->{'provides'}}, $s unless grep {$_ eq $s} @{$data->{'provides'} || []};
    }
  }
  delete $data->{'checksum'} unless $options->{'withchecksum'};
  delete $data->{'license'} unless $options->{'withlicense'};
  delete $data->{'vendor'} unless $options->{'withvendor'};
  return generic_add_result(@_);
}

sub parse_repomd {
  return generic_parse($repomdparser, @_);
}

sub parse {
  return generic_parse($primaryparser, @_);
}

1;
07070100000017000081a400000000000000000000000163e504b900000d2a000000000000000000000000000000000000001400000000Build/SimpleJSON.pm################################################################
#
# Copyright (c) 2018 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::SimpleJSON;

use strict;

sub unparse_keys {
  my ($d, $order, $keepspecial) = @_;
  my @k = sort keys %$d;
  if (!$keepspecial) {
    @k = grep {$_ ne '_start' && $_ ne '_end' && $_ ne '_order' && $_ ne '_type'} @k;
    $order = $d->{'_order'} if $d->{'_order'};
  }
  return @k unless $order;
  my %k = map {$_ => 1} @k;
  my @ko;
  for (@$order) {
    push @ko, $_ if delete $k{$_};
  }
  return (@ko, grep {$k{$_}} @k);
}

my %specialescapes = (
  '"' => '\\"',
  '\\' => '\\\\',
  '/' => '\\/',
  "\b" => '\\b',
  "\f" => '\\f',
  "\n" => '\\n',
  "\r" => '\\r',
  "\t" => '\\t',
);

sub unparse_string {
  my ($d) = @_;
  $d =~ s/([\"\\\000-\037])/$specialescapes{$1} || sprintf('\\u%04d', ord($1))/ge;
  return "\"$d\"";
}

sub unparse_bool {
  my ($d) = @_;
  return $d ? 'true' : 'false';
}

sub unparse_number {
  my ($d) = @_;
  return sprintf("%.f", $d) if $d == int($d);
  return sprintf("%g", $d);
}

sub unparse {
  my ($d, %opts) = @_;

my $r = '';
  my $template = delete $opts{'template'};
  $opts{'_type'} ||= $template if $template && !ref($template);
  undef $template unless ref($template) eq 'HASH';
  if (ref($d) eq 'ARRAY') {
    return '[]' unless @$d;
    $opts{'template'} = $template if $template;
    my $indent = $opts{'ugly'} ? '' : $opts{'indent'} || '';
    my $nl = $opts{'ugly'} ? '' : "\n";
    my $sp = $opts{'ugly'} ? '' : " ";
    my $first = 0;
    for my $dd (@$d) {
      $r .= ",$nl" if $first++;
      $r .= "$indent$sp$sp$sp".unparse($dd, %opts, 'indent' => "   $indent");
    }
    return "\[$nl$r$nl$indent\]";
  }
  if (ref($d) eq 'HASH') {
    my $keepspecial = $opts{'keepspecial'};
    my @k = unparse_keys($d, $template ? $template->{'_order'} : undef, $keepspecial);
    return '{}' unless @k;
    my $indent = $opts{'ugly'} ? '' : $opts{'indent'} || '';
    my $nl = $opts{'ugly'} ? '' : "\n";
    my $sp = $opts{'ugly'} ? '' : " ";
    my $first = 0;
    for my $k (@k) {
      $opts{'template'} = $template->{$k} || $template->{'*'} if $template;
      $r .= ",$nl" if $first++;
      my $dd = $d->{$k};
      my $type = $keepspecial ? undef : $d->{'_type'};
      $r .= "$indent$sp$sp$sp".unparse_string($k)."$sp:$sp".unparse($dd, %opts, 'indent' => "   $indent", '_type' => ($type || {})->{$k});
    }
    return "\{$nl$r$nl$indent\}";
  }
  return 'null' unless defined $d;
  my $type = $opts{'_type'} || '';
  return unparse_bool($d) if $type eq 'bool';
  return unparse_number($d) if $type eq 'number';
  return unparse_string($d);
}

1;
07070100000018000081a400000000000000000000000163e504b9000013b6000000000000000000000000000000000000001300000000Build/SimpleXML.pm################################################################
#
# Copyright (c) 1995-2016 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::SimpleXML;

use strict;

# very simple xml parser, just good enough to parse kiwi and _service files...
# can't use standard XML parsers, unfortunatelly, as the build script
# must not rely on external libraries
#
sub parse {
  my ($xml, %opts) = @_;

my $record = $opts{'record'};
  my $order = $opts{'order'};
  my @nodestack;
  my $node = {};
  my $c = '';
  my $xmllen = length($xml);
  $xml =~ s/^\s*\<\?.*?\?\>//s;
  while ($xml =~ /^(.*?)\</s) {
    if ($1 ne '') {
      $c .= $1;
      $xml = substr($xml, length($1));
    }
    if (substr($xml, 0, 4) eq '//s;
      next;
    }
    my $elstart = length($xml);
    die("bad xml\n") unless $xml =~ /(.*?\>)/s;
    my $tag = $1;
    $xml = substr($xml, length($tag));
    my $mode = 0;
    if ($tag =~ s/^\<\///s) {
      chop $tag;
      $mode = 1;	# end
    } elsif ($tag =~ s/\/\>$//s) {
      $mode = 2;	# start & end
      $tag = substr($tag, 1);
    } else {
      $tag = substr($tag, 1);
      chop $tag;
    }
    my @tag = split(/(=(?:\"[^\"]*\"|\'[^\']*\'|[^\"\s]*))?\s+/, "$tag ");
    $tag = shift @tag;
    shift @tag;
    push @tag, undef if @tag & 1;
    my %atts = @tag;
    for (values %atts) {
      next unless defined $_;
      s/^=\"([^\"]*)\"$/=$1/s or s/^=\'([^\']*)\'$/=$1/s;
      s/^=//s;
      s/&lt;/</g;
      s/&gt;/>/g;
      s/&amp;/&/g;
      s/&apos;/\'/g;
      s/&quot;/\"/g;
    }
    if ($mode == 0 || $mode == 2) {
      my $n = {};
      if ($record) {
        $n->{'_start'} = $xmllen - $elstart;
        $n->{'_end'} = $xmllen - length($xml) if $mode == 2;
      }
      if ($order) {
        push @{$node->{'_order'}}, $tag;
        push @{$n->{'_order'}}, (splice(@tag, 0, 2))[0] while @tag;
      }
      push @{$node->{$tag}}, $n;
      $n->{$_} = $atts{$_} for sort keys %atts;
      if ($mode == 0) {
	push @nodestack, [ $tag, $node, $c ];
	$c = '';
	$node = $n;
      }
    } else {
      die("element '$tag' closes without open\n") unless @nodestack;
      die("element '$tag' closes, but I expected '$nodestack[-1]->[0]'\n") unless $nodestack[-1]->[0] eq $tag;
      if (!$opts{'notrim'}) {
        $c =~ s/^\s*//s;
        $c =~ s/\s*$//s;
        $c = undef if $c eq '';
      }
      $node->{'_content'} = $c if defined $c;
      $node->{'_end'} = $xmllen - length($xml) if $record;
      $node = $nodestack[-1]->[1];
      $c = $nodestack[-1]->[2];
      pop @nodestack;
    }
  }
  $c .= $xml;
  if (!$opts{'notrim'}) {
    $c =~ s/^\s*//s;
    $c =~ s/\s*$//s;
    $c = undef if $c eq '';
  }
  $node->{'_content'} = $c if defined $c;
  return $node;
}

sub unparse_keys {
  my ($d) = @_;
  my @k = grep {$_ ne '_start' && $_ ne '_end' && $_ ne '_order' && $_ ne '_content'} sort keys %$d;
  return @k unless $d->{'_order'};
  my %k = map {$_ => 1} @k;
  my @ko;
  for (@{$d->{'_order'}}) {
    push @ko, $_ if delete $k{$_};
  }
  return (@ko, grep {$k{$_}} @k);
}

sub unparse_escape {
  my ($d) = @_;
  $d =~ s/&/&amp;/sg;
  $d =~ s/</&lt;/sg;
  $d =~ s/>/&gt;/sg;
  $d =~ s/"/&quot;/sg;
  return $d;
}

sub unparse {
  my ($d, %opts) = @_;

my $r = '';
  my $indent = $opts{'ugly'} ? '' : $opts{'indent'} || '';
  my $nl = $opts{'ugly'} ? '' : "\n";
  my @k = unparse_keys($d);
  my @e = grep {ref($d->{$_}) ne ''} @k;
  for my $e (@e) {
    my $en = unparse_escape($e);
    my $de = $d->{$e};
    $de = [ $de ] unless ref($de) eq 'ARRAY';
    for my $se (@$de) {
      if (defined($se) && ref($se) eq '') {
	$r .= "$indent<$en>".unparse_escape($se)."</$en>$nl";
	next;
      }
      if (!$se || !%$se) {
        $r .= "$indent<$en/>$nl";
	next;
      }
      my @sk = unparse_keys($se);
      my @sa = grep {ref($se->{$_}) eq ''} @sk;
      my @se = grep {ref($se->{$_}) ne ''} @sk;
      $r .= "$indent<$en";
      for my $sa (@sa) {
	$r .= " ".unparse_escape($sa);
	$r .= '="'.unparse_escape($se->{$sa}).'"' if defined $se->{$sa};
      }
      $r .= ">";
      $r .= unparse_escape($se->{'_content'}) if defined $se->{'_content'};
      $r .= $nl . unparse($se, %opts, 'indent' => "  $indent") . "$indent" if @se;
      $r .= "</$en>$nl";
    }
  }
  return $r;
}

1;
07070100000019000081a400000000000000000000000163e504b9000019c5000000000000000000000000000000000000001400000000Build/SimpleYAML.pm################################################################
#
# Copyright (c) 2021 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::SimpleYAML;

use strict;

use Scalar::Util;

sub unparse_keys {
  my ($d, $order) = @_;
  my @k = grep {$_ ne '_start' && $_ ne '_end' && $_ ne '_order' && $_ ne '_type'} sort keys %$d;
  return @k unless $d->{'_order'} || $order;
  my %k = map {$_ => 1} @k;
  my @ko;
  for (@{$d->{'_order'} || $order}) {
    push @ko, $_ if delete $k{$_};
  }
  return (@ko, grep {$k{$_}} @k);
}

my %specialescapes = (
  "\0" => '\\0',
  "\a" => '\\a',
  "\b" => '\\b',
  "\t" => '\\t',
  "\n" => '\\n',
  "\013" => '\\v',
  "\f" => '\\f',
  "\r" => '\\r',
  "\e" => '\\e',
  "\x85" => '\\N',
);

sub unparse_string {
  my ($d, $inline) = @_;
  return "''" unless length $d;
  return "\"$d\"" if Scalar::Util::looks_like_number($d);
  if ($d =~ /[\x00-\x1f\x7f-\x9f\']/) {
    $d =~ s/\\/\\\\/g;
    $d =~ s/\"/\\\"/g;
    $d =~ s/([\x00-\x1f\x7f-\x9f])/$specialescapes{$1} || '\x'.sprintf("%X",ord($1))/ge;
    return "\"$d\"";
  } elsif ($d =~ /^[\!\&*{}[]|>@`"'#%, ]/s) {
    return "'$d'";
  } elsif ($inline && $d =~ /[,\[\]\{\}]/) {
    return "'$d'";
  } elsif ($d =~ /: / || $d =~ / #/ || $d =~ /[: \t]\z/) {
    return "'$d'";
  } elsif ($d eq '~' || $d eq 'null' || $d eq 'true' || $d eq 'false' && $d =~ /^(?:---|\.\.\.)/s) {
    return "'$d'";
  } elsif ($d =~ /^[-?:](?:\s|\z)/s) {
    return "'$d'";
  } else {
    return $d;
  }
}

sub unparse_literal {
  my ($d, $indent) = @_;
  return unparse_string($d) if !defined($d) || $d eq '' || $d =~ /[\x00-\x09\x0b-\x1f\x7f-\x9f]/;
  my @lines = split("\n", $d, -1);
  return "''" unless @lines;
  my $r = '|';
  my @nonempty = grep {$_ ne ''} @lines;
  $r .= '2' if @nonempty && $nonempty[0] =~ /^ /;
  if ($lines[-1] ne '') {
    $r .= '-';
  } else {
    pop @lines;
    $r .= '+' if @lines && $lines[-1] eq '';
  }
  $r .= $_ ne '' ? "\n$indent$_" : "\n" for @lines;
  return $r;
}

sub unparse_folded {
  my ($d, $indent) = @_;
  return unparse_string($d) if !defined($d) || $d eq '' || $d =~ /[\x00-\x09\x0b-\x1f\x7f-\x9f]/;
  my @lines = split("\n", $d, -1);
  return "''" unless @lines;
  my $r = '>';
  my @nonempty = grep {$_ ne ''} @lines;
  $r .= '2' if @nonempty && $nonempty[0] =~ /^ /;
  if ($lines[-1] ne '') {
    $r .= '-';
  } else {
    pop @lines;
    $r .= '+' if @lines && $lines[-1] eq '';
  }
  my $neednl;
  my $ll = 78 - length($indent);
  $ll = 40 if $ll < 40;
  for (splice(@lines)) {
    if ($_ =~ /^ /) {
      push @lines, $_;
      $neednl = 0;
      next;
    }
    push @lines, '' if $neednl;
    while (length($_) > $ll && (/^(.{1,$ll}[^ ]) [^ ]/s || /^(..*?[^ ]) [^ ]/s)) {
      push @lines, $1;
      $_ = substr($_, length($1) + 1);
    }
    push @lines, $_;
    $neednl = 1;
  }
  $r .= $_ ne '' ? "\n$indent$_" : "\n" for @lines;
  return $r;
}

sub unparse_bool {
  my ($d) = @_;
  return $d ? 'true' : 'false';
}

sub unparse_number {
  my ($d) = @_;
  return $1 if $d =~ /\A0*([1-9][0-9]*)\z/s;
  return sprintf("%.f", $d) if $d == int($d);
  return sprintf("%g", $d);
}

sub unparse {
  my ($d, %opts) = @_;

return "---\n".unparse($d, %opts, 'noheader' => 1)."\n...\n" unless $opts{'noheader'};
  my $r = '';
  my $template = delete $opts{'template'};
  $opts{'_type'} ||= $template if $template && !ref($template);
  undef $template unless ref($template) eq 'HASH';
  if (ref($d) eq 'ARRAY') {
    return '[]' unless @$d;
    $opts{'template'} = $template if $template;
    $opts{'inline'} = 1 if $opts{'_type'} && $opts{'_type'} =~ s/^inline_?//;
    if ($opts{'inline'}) {
      my $first = 0;
      for my $dd (@$d) {
        $r .= ", " if $first++;
        $r .= unparse($dd, %opts);
      }
      return "\[$r\]";
    }
    my $indent = $opts{'indent'} || '';
    my $first = 0;
    for my $dd (@$d) {
      $r .= "\n$indent" if $first++;
      $r .= "- ".unparse($dd, %opts, 'indent' => "  $indent");
    }
    return $r;
  }
  if (ref($d) eq 'HASH') {
    my @k = unparse_keys($d, $template ? $template->{'_order'} : undef);
    return '{}' unless @k;
    $opts{'inline'} = 1 if $opts{'_type'} && $opts{'_type'} =~ s/^inline_?//;
    if ($opts{'inline'}) {
      my $first = 0;
      for my $k (@k) {
        $opts{'template'} = $template->{$k} || $template->{'*'} if $template;
        $r .= ", " if $first++;
        my $dd = $d->{$k};
        my $type = ($d->{'_type'} || {})->{$k};
        $r .= unparse_string($k).": ".unparse($dd, %opts, '_type' => $type);
      }
      return "\{$r\}";
    }
    my $indent = $opts{'indent'} || '';
    my $first = 0;
    for my $k (@k) {
      $opts{'template'} = $template->{$k} || $template->{'*'} if $template;
      my $dd = $d->{$k};
      my $type = ($d->{'_type'} || {})->{$k} || ($d->{'_type'} || {})->{'*'};
      $type = $opts{'template'} if !$type && $opts{'template'} && !ref($opts{'template'});
      $r .= "\n$indent" if $first++;
      $r .= unparse_string($k).":";
      if (ref($dd) eq 'ARRAY' && @$dd && !($type && $type =~ /^inline_?/)) {
        $r .= "\n$indent";
        $r .= unparse($dd, %opts, 'indent' => "$indent", '_type' => $type);
      } elsif (ref($dd) eq 'HASH' && %$dd && !($type && $type =~ /^inline_?/)) {
        $r .= "\n$indent  ";
        $r .= unparse($dd, %opts, 'indent' => "  $indent", '_type' => $type);
      } else {
        $r .= " ".unparse($dd, %opts, 'indent' => "  $indent", '_type' => $type);
      }
    }
    return $r;
  }
  my $type = $opts{'_type'} || '';
  return '~' unless defined $d;
  return unparse_bool($d) if $type eq 'bool';
  return unparse_number($d) if $type eq 'number';
  return unparse_literal($d, $opts{'indent'} || '') if $type eq 'literal' && !$opts{'inline'};
  return unparse_folded($d, $opts{'indent'} || '') if $type eq 'folded' && !$opts{'inline'};
  return unparse_string($d, $opts{'inline'});
}

1;
0707010000001a000081a400000000000000000000000163e504b900000a4a000000000000000000000000000000000000001300000000Build/Snapcraft.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Snapcraft;

use strict;
use Build::Deb;

eval { require YAML::XS; $YAML::XS::LoadBlessed = 0; };
*YAML::XS::LoadFile = sub {die("YAML::XS is not available\n")} unless defined &YAML::XS::LoadFile;

sub parse {
  my ($cf, $fn) = @_;

my $yaml;
  eval {$yaml = YAML::XS::LoadFile($fn);};
  return {'error' => "Failed to parse yaml file"} unless $yaml;

my $ret = {};
  $ret->{'name'} = $yaml->{'name'};
  $ret->{'version'} = $yaml->{'version'};
  $ret->{'epoch'} = $yaml->{'epoch'} if $yaml->{'epoch'};

# how should we report the built apps?
  my @packdeps;
  for my $p (@{$yaml->{'stage-packages'} || []}) {
    push @packdeps, $p;
  }
  for my $p (@{$yaml->{'build-packages'} || []}) {
    push @packdeps, $p;
  }
  for my $p (@{$yaml->{'after'} || []}) {
    push @packdeps, "snapcraft-part:$p";
  }

for my $key (sort keys(%{$yaml->{'parts'} || {}})) {
    my $part = $yaml->{'parts'}->{$key};
    push @packdeps, "snapcraft-plugin:$part->{plugin}" if defined $part->{plugin};
    for my $p (@{$part->{'stage-packages'} || []}) {
      push @packdeps, $p;
    }
    for my $p (@{$part->{'build-packages'} || []}) {
      push @packdeps, $p;
    }
    for my $p (@{$part->{'after'} || []}) {
      next if $yaml->{'parts'}->{$p};
      push @packdeps, "build-snapcraft-part-$p";
    }
  }

my %exclarchs;
  for my $arch (@{$yaml->{architectures} || []}) {
    my @obsarchs = Build::Deb::obsarch($arch);
    push @obsarchs, $arch unless @obsarchs;
    $exclarchs{$_} = 1 for @obsarchs;
  }

$ret->{'exclarch'} = [ sort keys %exclarchs ] if %exclarchs;
#  $ret->{'badarch'} = $badarch if defined $badarch;
  $ret->{'deps'} = \@packdeps;
#  $ret->{'prereqs'} = \@prereqs if @prereqs;
#  $ret->{'configdependent'} = 1 if $ifdeps;

return $ret;
}

1;
0707010000001b000081a400000000000000000000000163e504b900001113000000000000000000000000000000000000001200000000Build/Susetags.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Susetags;

use strict;

use Build::Rpm;

# compatibility to old OBS code
sub parse_obs_compat {
  my ($file, undef, undef, @arches) = @_;
  $file = "$file.gz" if ! -e $file && -e "$file.gz";
  my $pkgs = {};
  parse($file, sub {
    my ($data) = @_;
    my $medium = delete($data->{'medium'});
    my $loc = delete($data->{'location'});
    if (defined($medium) && defined($loc)) {
      $loc =~ s/^\Q$data->{'arch'}\E\///;
      $data->{'path'} = "$medium $loc";
    }
    return unless !@arches || grep { /$data->{'arch'}/ } @arches;
    $pkgs->{"$data->{'name'}-$data->{'version'}-$data->{'release'}-$data->{'arch'}"} = $data;
  }, 'addselfprovides' => 1);
  return $pkgs;
}

my %tmap = (
  'Pkg' => '',
  'Loc' => 'location',
  'Src' => 'source',
  'Prv' => 'provides',
  'Req' => 'requires',
  'Con' => 'conflicts',
  'Obs' => 'obsoletes',
  'Rec' => 'recommends',
  'Sug' => 'suggests',
  'Sup' => 'supplements',
  'Enh' => 'enhances',
  'Tim' => 'buildtime',
  'Cks' => 'checksum',
);

sub addpkg {
  my ($res, $data, $options) = @_;
  # fixup location and source
  if (exists($data->{'location'})) {
    my ($medium, $dir, $loc) = split(' ', $data->{'location'}, 3);
    $data->{'medium'} = $medium;
    $data->{'location'} = defined($loc) ? "$dir/$loc" : "$data->{'arch'}/$dir";
  }
  $data->{'source'} =~ s/\s.*// if exists $data->{'source'};
  if ($options->{'addselfprovides'} && defined($data->{'name'}) && defined($data->{'version'})) {
    if (($data->{'arch'} || '') ne 'src' && ($data->{'arch'} || '') ne 'nosrc') {
      my $evr = $data->{'version'};
      $evr = "$data->{'epoch'}:$evr" if $data->{'epoch'};
      $evr = "$evr-$data->{'release'}" if defined $data->{'release'};
      my $s = "$data->{'name'} = $evr";
      push @{$data->{'provides'}}, $s unless grep {$_ eq $s} @{$data->{'provides'} || []};
    }
  }
  if ($options->{'withchecksum'} && $data->{'checksum'}) {
    my ($ctype, $csum) = split(' ', delete($data->{'checksum'}));
    $ctype = lc($ctype || '');
    $data->{'checksum'} = "$ctype:$csum" if $csum && ($ctype eq 'md5' || $ctype eq 'sha1' || $ctype eq 'sha256' || $ctype eq 'sha512');
  }
  if (ref($res) eq 'CODE') {
    $res->($data);
  } else {
    push @$res, $data;
  }
}

sub parse {
  return parse_obs_compat(@_) if @_ > 2 && !defined $_[2];
  my ($in, $res, %options) = @_;
  $res ||= [];
  my $fd;
  if (ref($in)) {
    $fd = $in;
  } else {
    if ($in =~ /\.gz$/) {
      open($fd, '-|', "gzip", "-dc", $in) || die("$in: $!\n");
    } else {
      open($fd, '<', $in) || die("$in: $!\n");
    }
  }
  my $cur;
  my @tmap = sort keys %tmap;
  @tmap = grep {$_ ne 'Cks'} @tmap unless $options{'withchecksum'};
  my $r = join('|', @tmap);
  $r = qr/^([\+=])($r):\s*(.*)/;
  while (<$fd>) {
    chomp;
    next unless /$r/;
    my ($multi, $tag, $data) = ($1, $2, $3);
    if ($multi eq '+') {
      while (<$fd>) {
	chomp;
	last if /^-\Q$tag\E/;
	next if $tag eq 'Req' && /^rpmlib\(/;
	$_ = Build::Rpm::testcaseformat($_) if /^\(/ && $options{'testcaseformat'};
	push @{$cur->{$tmap{$tag}}}, $_;
      }
    } elsif ($tag eq 'Pkg') {
      addpkg($res, $cur, \%options) if $cur;
      $cur = {};
      ($cur->{'name'}, $cur->{'version'}, $cur->{'release'}, $cur->{'arch'}) = split(' ', $data);
      $cur->{'epoch'} = $1 if $cur->{'version'} =~ s/^(\d+)://;
    } else {
      $cur->{$tmap{$tag}} = $data;
    }
  }
  addpkg($res, $cur, \%options) if $cur;
  if (!ref($in)) {
    close($fd) || die("close $in: $!\n");
  }
  return $res;
}
  
1;
0707010000001c000081a400000000000000000000000163e504b9000009a8000000000000000000000000000000000000000e00000000Build/Zypp.pm################################################################
#
# Copyright (c) 1995-2014 SUSE Linux Products GmbH
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License version 2 or 3 as
# published by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program (see the file COPYING); if not, write to the
# Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
#
################################################################

package Build::Zypp;

use strict;

our $root = '';

sub parsecfg {
  my ($repocfg, $reponame, $allrepos) = @_;

local *REPO;
  open(REPO, '<', "$root/etc/zypp/repos.d/$repocfg") or return undef;
  my $name;
  my $repo = {};
  while (<REPO>) {
    chomp;
    next if /^\s*#/;
    s/\s+$//;
    if (/^\[(.+)\]/) {
      if ($allrepos && defined($name)) {
	$repo->{'description'} = $repo->{'name'} if defined $repo->{'name'};
	$repo->{'name'} = $name;
	push @$allrepos, $repo;
	undef $name;
	$repo = {};
      }
      last if defined $name;
      $name = $1 if !defined($reponame) || $reponame eq $1;
    } elsif (defined($name)) {
      my ($key, $value) = split(/=/, $_, 2);
      $repo->{$key} = $value if defined $key;
    }
  }
  close(REPO);
  return undef unless defined $name;
  $repo->{'description'} = $repo->{'name'} if defined $repo->{'name'};
  $repo->{'name'} = $name;
  push @$allrepos, $repo if $allrepos;
  return $repo;
}

sub repofiles {
  local *D;
  return () unless opendir(D, "/etc/zypp/repos.d");
  my @r = grep {!/^\./ && /.repo$/} readdir(D);
  closedir D;
  return sort(@r);
}

sub parseallrepos {
  my @r;
  for my $r (repofiles()) {
    parsecfg($r, undef, \@r);
  }
  return @r;
}

sub parserepo($) {
  my ($reponame) = @_;
  # first try matching .repo file
  if (-e "$root/etc/zypp/repos.d/$reponame.repo") {
    my $repo = parsecfg("$reponame.repo", $reponame);
    return $repo if $repo;
  }
  # then try all repo files
  for my $r (repofiles()) {
    my $repo = parsecfg($r, $reponame);
    return $repo if $repo;
  }
  die("could not find repo '$reponame'\n");
}

# vim: sw=2
0707010000001d000041ed00000000000000000000000163e504b900000000000000000000000000000000000000000000000600000000Build07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000b00000000TRAILER!!!

Places

File Build.obscpio of Package build

Places