File PBuild.obscpio of Package build
07070100000000000081a400000000000000000000000163e504b900002368000000000000000000000000000000000000001300000000PBuild/AssetMgr.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 PBuild::AssetMgr;
use strict;
use Digest::MD5 ();
use PBuild::Util;
use PBuild::Source;
use PBuild::RemoteAssets;
use PBuild::Cpio;
our $goproxy_default = 'https://proxy.golang.org';
#
# Create the asset manager
#
sub create {
my ($assetdir) = @_;
return bless { 'asset_dir' => $assetdir, 'handlers' => [] };
}
#
# Add a new asset resource to the manager
#
sub add_assetshandler {
my ($assetmgr, $assetsurl) = @_;
my $type = '';
$type = $1 if $assetsurl =~ s/^([a-zA-Z0-9_]+)\@//;
if ($type eq 'fedpkg') {
push @{$assetmgr->{'handlers'}}, { 'url' => $assetsurl, 'type' => $type };
} elsif ($type eq 'goproxy') {
push @{$assetmgr->{'handlers'}}, { 'url' => $assetsurl, 'type' => $type };
} else {
die("unsupported assets url '$assetsurl'\n");
}
}
#
# Calculate the asset id used to cache the asset on-disk
#
sub get_assetid {
my ($file, $asset) = @_;
return $asset->{'assetid'} if $asset->{'assetid'};
my $digest = $asset->{'digest'};
if ($digest) {
return Digest::MD5::md5_hex("$digest $file");
} elsif ($asset->{'url'}) {
return Digest::MD5::md5_hex("$asset->{'url'} $file");
} else {
die("$file: asset must either have a digest or an url\n");
}
}
#
# calculate an id that identifies an mutable asset
#
sub calc_mutable_id {
my ($assetmgr, $asset) = @_;
my $assetid = $asset->{'assetid'};
my $adir = "$assetmgr->{'asset_dir'}/".substr($assetid, 0, 2);
my $fd;
if (open($fd, '<', "$adir/$assetid")) {
# already have it, use md5sum to track content
my $ctx = Digest::MD5->new;
$ctx->addfile($fd);
close $fd;
return $ctx->hexdigest();
}
# not available yet, use "download on demand" placeholder
return 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0';
}
#
# Add the asset information to the package's srcmd5
#
sub update_srcmd5 {
my ($assetmgr, $p) = @_;
my $old_srcmd5 = $p->{'srcmd5'};
return 0 unless $old_srcmd5;
my $asset_files = $p->{'asset_files'};
return 0 unless %{$asset_files || {}};
my %files = %{$p->{'files'}};
for my $file (sort keys %$asset_files) {
my $asset = $asset_files->{$file};
die unless $asset->{'assetid'};
# use first part of digest if we have one
if ($asset->{'digest'} && $asset->{'digest'} =~ /:([a-f0-9]{32})/) {
$files{$file} = $1;
} elsif ($asset->{'immutable'}) {
$files{$file} = substr($asset->{'assetid'}, 0, 32);
} else {
$files{$file} = calc_mutable_id($assetmgr, $asset);
}
}
$p->{'srcmd5'} = PBuild::Source::calc_srcmd5(\%files);
return $p->{'srcmd5'} eq $old_srcmd5 ? 0 : 1;
}
#
# Merge assets into the asset_files hash
#
sub merge_assets {
my ($assetmgr, $p, $assets) = @_;
my $files = $p->{'files'};
for my $asset (@{$assets || []}) {
my $file = $asset->{'file'};
if (!$assetmgr->{'keep_all_assets'}) {
# ignore asset if present in source list
next if $files->{$file} || $files->{"$file/"};
}
$asset->{'assetid'} ||= get_assetid($file, $asset);
$p->{'asset_files'}->{$file} = $asset;
}
}
#
# Generate asset information from the package source
#
sub find_assets {
my ($assetmgr, $p) = @_;
my $bt = $p->{'buildtype'} || '';
my @assets;
push @assets, @{$p->{'source_assets'} || []};
push @assets, PBuild::RemoteAssets::fedpkg_parse($p) if $p->{'files'}->{'sources'};
push @assets, PBuild::RemoteAssets::golang_parse($p) if $p->{'files'}->{'go.sum'};
push @assets, PBuild::RemoteAssets::recipe_parse($p) if $bt eq 'spec' || $bt eq 'kiwi' || $bt eq 'arch' || $bt eq 'docker';
merge_assets($assetmgr, $p, \@assets);
update_srcmd5($assetmgr, $p) if $p->{'asset_files'};
}
#
# Does a package have assets that may change over time?
#
sub has_mutable_assets {
my ($assetmgr, $p) = @_;
for my $asset (values %{$p->{'asset_files'} || {}}) {
return 1 unless $asset->{'digest'} || $asset->{'immutable'};
}
return 0;
}
#
# remove the assets that we have cached on-disk
#
sub prune_cached_assets {
my ($assetmgr, @assets) = @_;
my $assetdir = $assetmgr->{'asset_dir'};
my @pruned;
for my $asset (@assets) {
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
push @pruned, $asset unless -e "$adir/$assetid";
}
return @pruned;
}
#
# Make sure that we have all remote assets in our on-disk cache
#
sub getremoteassets {
my ($assetmgr, $p) = @_;
my $asset_files = $p->{'asset_files'};
return unless $asset_files;
my $assetdir = $assetmgr->{'asset_dir'};
my %assetid_seen;
my @assets;
# unify over the assetid
for my $asset (map {$asset_files->{$_}} sort keys %$asset_files) {
push @assets, $asset unless $assetid_seen{$asset->{'assetid'}}++;
}
@assets = prune_cached_assets($assetmgr, @assets);
for my $handler (@{$assetmgr->{'handlers'}}) {
last unless @assets;
if ($handler->{'type'} eq 'fedpkg') {
PBuild::RemoteAssets::fedpkg_fetch($p, $assetdir, \@assets, $handler->{'url'});
} elsif ($handler->{'type'} eq 'goproxy') {
PBuild::RemoteAssets::golang_fetch($p, $assetdir, \@assets, $handler->{'url'});
} else {
die("unsupported assets type $handler->{'type'}\n");
}
@assets = prune_cached_assets($assetmgr, @assets);
}
if (grep {($_->{'type'} || '') eq 'ipfs'} @assets) {
PBuild::RemoteAssets::ipfs_fetch($p, $assetdir, \@assets);
@assets = prune_cached_assets($assetmgr, @assets);
}
if (grep {($_->{'type'} || '') eq 'golang'} @assets) {
if (!grep {$_->{'type'} eq 'goproxy'} (@{$assetmgr->{'handlers'}})) {
PBuild::RemoteAssets::golang_fetch($p, $assetdir, \@assets, $goproxy_default);
@assets = prune_cached_assets($assetmgr, @assets);
}
}
if (grep {($_->{'type'} || '') eq 'url'} @assets) {
PBuild::RemoteAssets::url_fetch($p, $assetdir, \@assets);
@assets = prune_cached_assets($assetmgr, @assets);
}
if (@assets) {
my @missing = sort(map {$_->{'file'}} @assets);
print "missing assets: @missing\n";
$p->{'error'} = "missing assets: @missing";
return;
}
update_srcmd5($assetmgr, $p) if has_mutable_assets($assetmgr, $p);
}
sub unpack_obscpio_asset {
my ($assetmgr, $obscpio, $srcdir, $file) = @_;
PBuild::Cpio::cpio_extract($obscpio, sub {
my $name = $_[0]->{'name'};
!$_[1] && ($name eq $file || $name =~ /^\Q$file\E\//) ? "$srcdir/$name" : undef
}, 'postpone_symlinks' => 1, 'set_mode' => 1, 'set_mtime' => 1);
}
#
# Copy the assets from our cache to the build root
#
sub copy_assets {
my ($assetmgr, $p, $srcdir, $unpack) = @_;
my $assetdir = $assetmgr->{'asset_dir'};
my $asset_files = $p->{'asset_files'};
for my $file (sort keys %{$asset_files || {}}) {
my $asset = $asset_files->{$file};
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
die("asset $assetid is gone\n") unless -e "$adir/$assetid";
if ($asset->{'isdir'} && $unpack) {
unpack_obscpio_asset($assetmgr, "$adir/$assetid", $srcdir, $file);
next;
}
PBuild::Util::cp("$adir/$assetid", $asset->{'isdir'} ? "$srcdir/$file.obscpio" : "$srcdir/$file");
}
if (has_mutable_assets($assetmgr, $p) && update_srcmd5($assetmgr, $p)) {
copy_assets($assetmgr, $p, $srcdir); # had a race, copy again
}
}
#
# Move the assets from our cache to the build root, destroying the cache
#
sub move_assets {
my ($assetmgr, $p, $srcdir, $unpack) = @_;
my $assetdir = $assetmgr->{'asset_dir'};
my $asset_files = $p->{'asset_files'};
for my $file (sort keys %{$asset_files || {}}) {
my $asset = $asset_files->{$file};
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
die("asset $assetid is gone\n") unless -e "$adir/$assetid";
if ($asset->{'isdir'}) {
if ($unpack && ! -d "$adir/$assetid") {
unpack_obscpio_asset($assetmgr, "$adir/$assetid", $srcdir, $file);
next;
}
if (!$unpack && -d "$adir/$assetid") {
die("packing of assets is not supported\n");
}
$file .= ".obscpio" if !$unpack;
}
rename("$adir/$assetid", "$srcdir/$file") || die("rename $adir/$assetid $srcdir/$file: $!\n");
}
if (has_mutable_assets($assetmgr, $p) && update_srcmd5($assetmgr, $p)) {
die("had a race in move_assets\n");
}
}
1;
07070100000001000081a400000000000000000000000163e504b900001c74000000000000000000000000000000000000001600000000PBuild/BuildResult.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 PBuild::BuildResult;
use strict;
use Digest::MD5 ();
use Build;
use Build::SimpleXML;
use PBuild::Util;
use PBuild::Verify;
use PBuild::Container;
my @binsufs = qw{rpm deb pkg.tar.gz pkg.tar.xz pkg.tar.zst};
my $binsufsre = join('|', map {"\Q$_\E"} @binsufs);
#
# create the .bininfo file that contains information about all binaries
# in the build artifacts
#
sub read_bininfo {
my ($dir, $withid) = @_;
my $bininfo;
my @bininfo_s;
local *BI;
if (open(BI, '<', "$dir/.bininfo")) {
@bininfo_s = stat(BI);
$bininfo = PBuild::Util::retrieve(\*BI, 1) if @bininfo_s && $bininfo_s[7];
close BI;
if ($bininfo) {
$bininfo->{'.bininfo'} = {'id' => "$bininfo_s[9]/$bininfo_s[7]/$bininfo_s[1]"} if $withid;
return $bininfo;
}
}
$bininfo = {};
@bininfo_s = ();
for my $file (PBuild::Util::ls($dir)) {
$bininfo->{'.nosourceaccess'} = {} if $file eq '.nosourceaccess';
if ($file !~ /\.(?:$binsufsre)$/) {
if ($file eq '.channelinfo' || $file eq 'updateinfo.xml') {
$bininfo->{'.nouseforbuild'} = {};
} elsif ($file =~ /\.obsbinlnk$/) {
my @s = stat("$dir/$file");
my $d = PBuild::Util::retrieve("$dir/$file", 1);
next unless @s && $d;
my $r = {%$d, 'filename' => $file, 'id' => "$s[9]/$s[7]/$s[1]"};
$bininfo->{$file} = $r;
} elsif ($file =~ /[-.]appdata\.xml$/) {
local *F;
open(F, '<', "$dir/$file") || next;
my @s = stat(F);
next unless @s;
my $ctx = Digest::MD5->new;
$ctx->addfile(*F);
close F;
$bininfo->{$file} = {'md5sum' => $ctx->hexdigest(), 'filename' => $file, 'id' => "$s[9]/$s[7]/$s[1]"};
}
next;
}
my @s = stat("$dir/$file");
next unless @s;
my $id = "$s[9]/$s[7]/$s[1]";
my $data;
eval {
my $leadsigmd5;
die("$dir/$file: no hdrmd5\n") unless Build::queryhdrmd5("$dir/$file", \$leadsigmd5);
$data = Build::query("$dir/$file", 'evra' => 1, 'conflicts' => 1, 'weakdeps' => 1, 'addselfprovides' => 1, 'filedeps' => 1, 'normalizedeps' => 1);
die("$dir/$file: query failed\n") unless $data;
PBuild::Verify::verify_nevraquery($data);
$data->{'leadsigmd5'} = $leadsigmd5 if $leadsigmd5;
};
if ($@) {
warn($@);
next;
}
$data->{'filename'} = $file;
$data->{'id'} = $id;
$bininfo->{$file} = $data;
}
eval {
PBuild::Util::store("$dir/.bininfo.new", "$dir/.bininfo", $bininfo);
@bininfo_s = stat("$dir/.bininfo");
$bininfo->{'.bininfo'} = {'id' => "$bininfo_s[9]/$bininfo_s[7]/$bininfo_s[1]"} if @bininfo_s && $withid;
};
warn($@) if $@;
return $bininfo;
}
#
# copy build artifacts from the build root to the destination
#
sub integrate_build_result {
my ($p, $result, $dst) = @_;
# delete old files
for my $file (sort(PBuild::Util::ls($dst))) {
next if $file eq '_meta' || $file eq '_meta.success' || $file eq '_meta.fail';
next if $file eq '_log' || $file eq '_log.success';
next if $file eq '_repository';
unlink("$dst/$file");
}
# copy new stuff over
for my $file (sort keys %$result) {
next if $file =~ /\.obsbinlnk$/s;
if ($file =~ /(.*)\.containerinfo$/) {
# create an obsbinlnk file from the containerinfo
my $prefix = $1;
die unless $result->{$file} =~ /^(.*)\/([^\/]+)$/;
my $obsbinlnk = PBuild::Container::containerinfo2obsbinlnk($1, $2, $p->{'pkg'});
PBuild::Util::store("$dst/$prefix.obsbinlnk", undef, $obsbinlnk) if $obsbinlnk;
}
PBuild::Util::cp($result->{$file}, "$dst/$file");
}
# create new bininfo
my $bininfo = read_bininfo($dst, 1);
return $bininfo;
}
#
# process a finished build job: copy artifacts, write extra
# information
#
sub integrate_job {
my ($builddir, $job, $code, $result) = @_;
my $p = $job->{'pdata'};
my $packid = $p->{'pkg'};
my $dst = "$builddir/$packid";
PBuild::Util::mkdir_p($dst);
unlink("$dst/_meta");
unlink("$dst/_log");
my $bininfo;
if ($code eq 'succeeded') {
$bininfo = integrate_build_result($p, $result, $dst);
PBuild::Util::writestr("$dst/._meta.$$", "$dst/_meta", join("\n", @{$job->{'meta'}})."\n");
unlink("$dst/_log.success");
unlink("$dst/_meta.success");
unlink("$dst/_meta.success");
link("$dst/_log", "$dst/_log.success");
link("$dst/_meta", "$dst/_meta.success");
unlink("$dst/_meta.fail");
} else {
PBuild::Util::cp($result->{'_log'}, "$dst/_log");
PBuild::Util::writestr("$dst/._meta.$$", "$dst/_meta", join("\n", @{$job->{'meta'}})."\n");
unlink("$dst/_meta.fail");
link("$dst/_meta", "$dst/_meta.fail");
}
unlink("$dst/_reason");
my $reason = $job->{'reason'};
if ($reason) {
$reason = PBuild::Util::clone($reason);
$reason->{'time'} = $job->{'readytime'};
$reason->{'_order'} = [ 'explain', 'time', 'oldsource', 'packagechange' ];
for (qw{explain time oldsource}) {
$reason->{$_} = [ $reason->{$_} ] if exists $reason->{$_};
}
my $reasonxml = Build::SimpleXML::unparse( { 'reason' => [ $reason ] });
PBuild::Util::writestr("$dst/._reason.$$", "$dst/_reason", $reasonxml);
}
return $bininfo;
}
#
# Create job data
#
sub makejobhist {
my ($p, $code, $readytime, $starttime, $endtime, $reason, $hostarch) = @_;
my $jobhist = {};
$jobhist->{'package'} = $p->{'pkg'};
$jobhist->{'code'} = $code;
$jobhist->{'readytime'} = $readytime;
$jobhist->{'starttime'} = $starttime;
$jobhist->{'endtime'} = $endtime;
$jobhist->{'srcmd5'} = $p->{'srcmd5'};
$jobhist->{'verifymd5'} = $p->{'verifymd5'} if $p->{'verifymd5'} && $p->{'verifymd5'} ne $p->{'srcmd5'};
$jobhist->{'reason'} = $reason->{'explain'} if $reason && $reason->{'explain'};
$jobhist->{'hostarch'} = $hostarch if $hostarch;
return $jobhist;
}
#
# Add job data to the _jobhistory file
#
sub addjobhist {
my ($builddir, $jobhist) = @_;
my $fd;
local $jobhist->{'_order'} = [ qw{package rev srcmd5 versrel bcnt readytime starttime endtime code uri workerid hostarch reason verifymd5} ];
my $jobhistxml = Build::SimpleXML::unparse({ 'jobhistlist' => [ { 'jobhist' => [ $jobhist ] } ] });
if (-s "$builddir/_jobhistory") {
open($fd, '+<', "$builddir/_jobhistory") || die("$builddir/_jobhistory: $!\n");
seek($fd, -15, 2);
print $fd substr($jobhistxml, 14);
close($fd);
} else {
PBuild::Util::writestr("$builddir/_jobhistory", undef, $jobhistxml);
}
}
1;
07070100000002000081a400000000000000000000000163e504b9000010b7000000000000000000000000000000000000001000000000PBuild/Cando.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 PBuild::Cando;
#
# the cando table maps the host architecture to the repository architectures
# that can be built on the host.
#
our %cando = (
# aarch64_ilp32: is just a software architecure convention
'aarch64' => [ 'aarch64', 'aarch64_ilp32', 'armv8l:linux32', 'armv7l:linux32', 'armv7hl:linux32', 'armv6l:linux32', 'armv6hl:linux32' ],
'aarch64_ilp32' => [ 'aarch64_ilp32', 'aarch64' ],
'armv4l' => [ 'armv4l' ],
'armv5l' => [ 'armv4l', 'armv5l' , 'armv5el' ],
'armv6l' => [ 'armv4l', 'armv5l', 'armv6l' , 'armv5el', 'armv6el' ],
'armv7l' => [ 'armv4l', 'armv5l', 'armv6l', 'armv7l', 'armv5el', 'armv6el', 'armv6hl', 'armv7el', 'armv7hl', 'armv8el', 'armv8hl', 'armv8l' ], # armv8* is a subset of armv7hl
'armv8l' => [ 'armv4l', 'armv5l', 'armv6l', 'armv7l', 'armv5el', 'armv6el', 'armv6hl', 'armv7el', 'armv7hl', 'armv8el', 'armv8hl', 'armv8l' ], # armv8l & armv7l are considered to be identical on rpm level
'sh4' => [ 'sh4' ],
'i586' => [ 'i586' ],
'i686' => [ 'i586', 'i686' ],
'x86_64' => [ 'x86_64', 'i586:linux32', 'i686:linux32' ],
'k1om' => [ 'k1om' ],
'parisc' => [ 'hppa', 'hppa64:linux64' ],
'parisc64'=> [ 'hppa64', 'hppa:linux32' ],
'ppc' => [ 'ppc' ],
'ppc64' => [ 'ppc64le', 'ppc64', 'ppc:linux32' ],
'ppc64p7' => [ 'ppc64le', 'ppc64p7', 'ppc:linux32' ],
'ppc64le' => [ 'ppc64le', 'ppc64', 'ppc:linux32' ],
'ia64' => [ 'ia64' ],
'riscv64' => [ 'riscv64' ],
's390' => [ 's390' ],
's390x' => [ 's390x', 's390:linux32' ],
'sparc' => [ 'sparcv8', 'sparc' ],
'sparc64' => [ 'sparc64v', 'sparc64', 'sparcv9v', 'sparcv9', 'sparcv8:linux32', 'sparc:linux32' ],
'mips' => [ 'mips' ],
'mips64' => [ 'mips64', 'mips:mips32' ],
'm68k' => [ 'm68k' ],
'local' => [ 'local' ],
);
our %knownarch;
for my $harch (keys %cando) {
for my $arch (@{$cando{$harch} || []}) {
if ($arch =~ /^(.*):/) {
$knownarch{$1}->{$harch} = $arch;
} else {
$knownarch{$arch}->{$harch} = $arch;
}
}
}
# keep in sync with extend_build_arch() in common_functions!
my %archfilter_extra = (
'aarch64' => [ 'aarch64_ilp32', 'armv8l' ],
'aarch64_ilp32' => [ 'aarch64', 'armv8l' ],
'armv8hl' => [ 'armv8l', 'armv7hl', 'armv7l', 'armv6hl', 'armv6l', 'armv5tel' ],
'armv8l' => [ 'armv7hl', 'armv7l', 'armv6hl', 'armv6l', 'armv5tel' ],
'armv7hl' => [ 'armv7l', 'armv6hl', 'armv6l', 'armv5tel' ],
'armv7l' => [ 'armv6l', 'armv5tel' ],
'armv6hl' => [ 'armv6l', 'armv5tel' ],
'armv6l' => [ 'armv5tel' ],
'mips64' => [ 'mips' ],
'i686' => [ 'i586', 'i486', 'i386' ],
'i586' => [ 'i486', 'i386' ],
'i486' => [ 'i386' ],
'parisc64' => [ 'hppa64', 'hppa' ],
'parisc' => [ 'hppa' ],
'ppc64' => [ 'ppc' ],
's390x' => [ 's390' ],
'sparc64v' => [ 'sparc64', 'sparcv9v', 'sparcv9', 'sparcv8', 'sparc' ],
'sparc64' => [ 'sparcv9', 'sparcv8', 'sparc' ],
'sparcv9v' => [ 'sparcv9', 'sparcv8', 'sparc' ],
'sparcv9' => [ 'sparcv8', 'sparc' ],
'sparcv8' => [ 'sparc' ],
'x86_64' => [ 'i686', 'i586', 'i486', 'i386' ],
);
sub archfilter {
my ($hostarch) = @_;
return $hostarch, @{$archfilter_extra{$hostarch} || []};
}
1;
07070100000003000081a400000000000000000000000163e504b9000060ae000000000000000000000000000000000000001200000000PBuild/Checker.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 PBuild::Checker;
use strict;
use Digest::MD5 ();
use Data::Dumper;
use PBuild::Expand;
use PBuild::Depsort;
use PBuild::Meta;
use PBuild::Util;
use PBuild::Job;
use PBuild::RepoMgr;
use PBuild::AssetMgr;
#
# Create a new package status checker
#
sub create {
my ($bconf, $arch, $buildtype, $pkgsrc, $builddir, $opts, $repomgr, $assetmgr) = @_;
my $genmetaalgo = $bconf->{'buildflags:genmetaalgo'};
$genmetaalgo = 1 unless defined $genmetaalgo;
my $ctx = {
'bconf' => $bconf,
'arch' => $arch,
'buildtype' => $buildtype,
'opts' => $opts,
'pkgsrc' => $pkgsrc,
'builddir' => $builddir,
'block' => undef, # block strategy (all,never)
'rebuild' => undef, # rebuild strategy (transitive,direct,local)
'debuginfo' => 1, # create debug packages?
'genmetaalgo' => $genmetaalgo,
'lastcheck' => {},
'metacache' => {},
'repomgr' => $repomgr,
'assetmgr' => $assetmgr,
};
$ctx->{'rebuild'} = $opts->{'buildtrigger'} if $opts->{'buildtrigger'};
return bless $ctx;
}
#
# Configure the repositories used for package building
#
sub prepare {
my ($ctx, $repos, $hostrepos) = @_;
my $dep2pkg = PBuild::Expand::configure_repos($ctx->{'bconf'}, $repos);
my %dep2src;
my %subpacks;
for my $n (sort keys %$dep2pkg) {
my $bin = $dep2pkg->{$n};
my $sn = $bin->{'source'};
$sn = $n unless defined $n;
$dep2src{$n} = $sn;
}
push @{$subpacks{$dep2src{$_}}}, $_ for keys %dep2src;
$ctx->{'dep2src'} = \%dep2src;
$ctx->{'dep2pkg'} = $dep2pkg;
$ctx->{'subpacks'} = \%subpacks;
PBuild::Meta::setgenmetaalgo($ctx->{'genmetaalgo'});
$ctx->{'dep2pkg_host'} = PBuild::Expand::configure_repos($ctx->{'bconf_host'}, $hostrepos) if $ctx->{'bconf_host'};
}
#
# Expand the package dependencies of all packages
#
sub pkgexpand {
my ($ctx, @pkgs) = @_;
my $bconf = $ctx->{'bconf'};
my $bconf_host = $ctx->{'bconf_host'};
if (($bconf_host || $bconf)->{'expandflags:preinstallexpand'}) {
my $err = Build::expandpreinstalls($bconf_host || $bconf);
die("cannot expand preinstalls: $err\n") if $err;
}
my $pkgsrc = $ctx->{'pkgsrc'};
my $subpacks = $ctx->{'subpacks'};
my $cross = $bconf_host ? 1 : 0;
for my $pkg (@pkgs) {
my $p = $pkgsrc->{$pkg};
if ($p->{'native'}) {
PBuild::Expand::expand_deps($p, $bconf_host, $subpacks);
} else {
PBuild::Expand::expand_deps($p, $bconf, $subpacks, $cross);
}
}
}
#
# Sort the packages by dependencies
#
sub pkgsort {
my ($ctx, @pkgs) = @_;
my %pdeps;
my %pkg2src;
my $pkgsrc = $ctx->{'pkgsrc'};
for my $pkg (@pkgs) {
my $p = $pkgsrc->{$pkg};
$pdeps{$pkg} = $p->{'dep_expanded'} || [];
$pkg2src{$pkg} = $p->{'name'} || $p->{'pkg'};
}
my @cycles;
my @sccs;
@pkgs = PBuild::Depsort::depsort2(\%pdeps, $ctx->{'dep2src'}, \%pkg2src, \@cycles, \@sccs, @pkgs);
my %cychash;
for my $cyc (@sccs) {
next if @$cyc < 2; # just in case
my @c = map {@{$cychash{$_} || [ $_ ]}} @$cyc;
@c = PBuild::Util::unify(sort(@c));
$cychash{$_} = \@c for @c;
}
#if (@sccs) {
# print " sccs:\n";
# print " - @{[sort @$_]}\n" for @sccs;
#}
#if (%cychash) {
# print " cycle components:\n";
# for (PBuild::Util::unify(sort(map {$_->[0]} values %cychash))) {
# print " - @{$cychash{$_}}\n";
# }
#}
$ctx->{'cychash'} = \%cychash;
return @pkgs;
}
#
# Check all packages if they need to be rebuilt
#
sub pkgcheck {
my ($ctx, $builders, @pkgs) = @_;
my %packstatus;
my %packdetails;
$ctx->{'building'} = {}; # building
$ctx->{'building'}->{$_->{'job'}->{'pdata'}->{'pkg'}} = $_->{'job'} for grep {$_->{'job'}} @$builders;
$ctx->{'notready'} = {}; # building or blocked
$ctx->{'nharder'} = 0;
my $builddir = $ctx->{'builddir'};
my $pkgsrc = $ctx->{'pkgsrc'};
my $cychash = $ctx->{'cychash'};
my %cycpass;
my @cpacks = @pkgs;
# now check every package
while (@cpacks) {
my $packid = shift @cpacks;
# cycle handling code
my $incycle = 0;
if ($cychash->{$packid}) {
($packid, $incycle) = handlecycle($ctx, $packid, \@cpacks, \%cycpass, \%packstatus);
next unless $incycle;
}
my $p = $pkgsrc->{$packid};
if ($p->{'error'}) {
if ($p->{'error'} =~ /^(excluded|disabled|locked)(?::(.*))?$/) {
$packstatus{$packid} = $1;
$packdetails{$packid} = $2 if $2;
next;
}
$packstatus{$packid} = 'broken';
$packdetails{$packid} = $p->{'error'};
next;
}
if ($p->{'dep_experror'}) {
$packstatus{$packid} = 'unresolvable';
$packdetails{$packid} = $p->{'dep_experror'};
next;
}
if ($ctx->{'building'}->{$packid}) {
my $job = $ctx->{'building'}->{$packid};
$packstatus{$packid} = 'building';
$packdetails{$packid} = "on builder $job->{'name'}" if $job->{'nbuilders'} > 1;
$ctx->{'notready'}->{$p->{'name'} || $p->{'pkg'}} = 1 if $p->{'useforbuildenabled'};
next;
}
recheck_package:
my ($status, $error) = check($ctx, $p, $incycle);
#printf("%s -> %s%s", $packid, $status, $error && $status ne 'scheduled' ? " ($error)" : '');
if ($status eq 'scheduled') {
my $builder;
for (@$builders) {
next if $_->{'job'};
$builder = $_;
last;
}
if (!$builder) {
($status, $error) = ('waiting', undef);
} else {
($status, $error) = build($ctx, $p, $error, $builder);
}
goto recheck_package if $status eq 'recheck'; # assets changed
if ($status eq 'building') {
my $job = $error;
$error = undef;
$error = "on builder $job->{'name'}" if $job->{'nbuilders'} > 1;
my $bid = ($builder->{'nbuilders'} || 1) > 1 ? "$builder->{'name'}: " : '';
if ($p->{'native'}) {
print "${bid}building $p->{'pkg'}/$p->{'recipe'} (native)\n";
} else {
print "${bid}building $p->{'pkg'}/$p->{'recipe'}\n";
}
$ctx->{'building'}->{$packid} = $builder->{'job'};
}
#printf("%s -> %s%s", $packid, $status, $error ? " ($error)" : '');
} elsif ($status eq 'done') {
# map done to succeeded/failed
if (-e "$builddir/$packid/_meta.fail") {
$status = 'failed';
} else {
$status = 'succeeded';
}
}
if ($status eq 'blocked' || $status eq 'building' || $status eq 'waiting') {
$ctx->{'notready'}->{$p->{'name'} || $p->{'pkg'}} = 1 if $p->{'useforbuildenabled'};
}
$packstatus{$packid} = $status;
$packdetails{$packid} = $error if defined $error;
}
my %result;
for my $packid (sort keys %packstatus) {
my $r = { 'code' => $packstatus{$packid} };
$r->{'details'} = $packdetails{$packid} if defined $packdetails{$packid};
$result{$packid} = $r;
}
return \%result;
}
#
# Generate the dependency tracking data for a image/container
#
sub genmeta_image {
my ($ctx, $p, $edeps) = @_;
if ($p->{'buildtype'} eq 'preinstallimage') {
my @pdeps = Build::get_preinstalls($ctx->{'bconf'});
my @vmdeps = Build::get_vminstalls($ctx->{'bconf'});
$edeps = [ PBuild::Util::unify(@$edeps, @pdeps, @vmdeps) ];
}
my $dep2pkg = $p->{'native'} ? $ctx->{'dep2pkg_host'} : $ctx->{'dep2pkg'};
my @new_meta;
for my $bin (@$edeps) {
my $q = $dep2pkg->{$bin};
push @new_meta, (($q || {})->{'hdrmd5'} || 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0')." $bin";
}
@new_meta = sort {substr($a, 34) cmp substr($b, 34) || $a cmp $b} @new_meta;
unshift @new_meta, ($p->{'verifymd5'} || $p->{'srcmd5'})." $p->{'pkg'}";
return \@new_meta;
}
#
# Generate the dependency tracking data for a package
#
sub genmeta {
my ($ctx, $p, $edeps, $hdeps) = @_;
my $buildtype = $p->{'buildtype'};
return genmeta_image($ctx, $p, $edeps) if $buildtype eq 'kiwi' || $buildtype eq 'docker' || $buildtype eq 'preinstallimage';
my $dep2pkg = $p->{'native'} ? $ctx->{'dep2pkg_host'} : $ctx->{'dep2pkg'};
my $metacache = $ctx->{'metacache'};
my @new_meta;
my $builddir = $ctx->{'builddir'};
for my $bin (@$edeps) {
my $q = $dep2pkg->{$bin};
my $binpackid = $q->{'packid'};
if (!defined $binpackid) {
# use the hdrmd5 for non-local packages
push @new_meta, ($q->{'hdrmd5'} || 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0')." $bin";
next;
}
# meta file is not in cache, read it
if (!exists $metacache->{$binpackid}) {
my $mf = "$builddir/$q->{'packid'}/_meta.success";
my $mfd;
die("$mf: $!\n") unless open($mfd, '<', $mf);
local $/ = undef;
$metacache->{$binpackid} = <$mfd>;
close($mfd);
die("$mf: bad meta\n") unless length($metacache->{$binpackid}) > 34;
}
PBuild::Meta::add_meta(\@new_meta, $metacache->{$binpackid}, $bin, $p->{'pkg'});
}
if ($hdeps) {
my $dep2pkg_host = $ctx->{'dep2pkg_host'};
my $hostarch = $ctx->{'hostarch'};
for my $bin (@$hdeps) {
my $q = $dep2pkg_host->{$bin};
push @new_meta, ($q->{'hdrmd5'} || 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0')." $hostarch:$bin";
}
}
@new_meta = PBuild::Meta::gen_meta($ctx->{'subpacks'}->{$p->{'name'}} || [], @new_meta);
unshift @new_meta, ($p->{'verifymd5'} || $p->{'srcmd5'})." $p->{'pkg'}";
return \@new_meta;
}
#
# Check the status of a single image/container
#
sub check_image {
my ($ctx, $p) = @_;
my $edeps = $p->{'dep_expanded'} || [];
my $notready = $ctx->{'notready'};
my $dep2src = $ctx->{'dep2src'};
my @blocked = grep {$notready->{$dep2src->{$_}}} @$edeps;
@blocked = () if $ctx->{'block'} && $ctx->{'block'} eq 'never';
if (@blocked) {
splice(@blocked, 10, scalar(@blocked), '...') if @blocked > 10;
return ('blocked', join(', ', @blocked));
}
my $new_meta = genmeta($ctx, $p, $edeps);
my $packid = $p->{'pkg'};
my $dst = "$ctx->{'builddir'}/$packid";
my @meta;
my $mfp;
if (open($mfp, '<', "$dst/_meta")) {
@meta = <$mfp>;
close $mfp;
chomp @meta;
}
return ('scheduled', [ { 'explain' => 'new build' } ]) if !@meta;
return ('scheduled', [ { 'explain' => 'source change', 'oldsource' => substr($meta[0], 0, 32) } ]) if $meta[0] ne $new_meta->[0];
return ('scheduled', [ { 'explain' => 'forced rebuild' } ]) if $p->{'force_rebuild'};
my $rebuildmethod = $ctx->{'rebuild'} || 'transitive';
if ($rebuildmethod eq 'local') {
return ('scheduled', [ { 'explain' => 'rebuild counter sync' } ]) if $ctx->{'relsynctrigger'}->{$packid};
return ('done');
}
if (@meta == @$new_meta && join('\n', @meta) eq join('\n', @$new_meta)) {
return ('scheduled', [ { 'explain' => 'rebuild counter sync' } ]) if $ctx->{'relsynctrigger'}->{$packid};
return ('done');
}
my @diff = PBuild::Meta::diffsortedmd5(\@meta, $new_meta);
my $reason = PBuild::Meta::sortedmd5toreason(@diff);
return ('scheduled', [ { 'explain' => 'meta change', 'packagechange' => $reason } ] );
}
#
# Check the status of a single package
#
sub check {
my ($ctx, $p, $incycle) = @_;
my $buildtype = $p->{'buildtype'};
return check_image($ctx, $p) if $buildtype eq 'kiwi' || $buildtype eq 'docker' || $buildtype eq 'preinstallimage';
my $packid = $p->{'pkg'};
my $notready = $ctx->{'notready'};
my $dep2src = $ctx->{'dep2src'};
my $edeps = $p->{'dep_expanded'} || [];
my $dst = "$ctx->{'builddir'}/$packid";
# calculate if we're blocked
my @blocked = grep {$notready->{$dep2src->{$_}}} @$edeps;
@blocked = () if $ctx->{'block'} && $ctx->{'block'} eq 'never';
# check if cycle builds are in progress
if ($incycle && $incycle == 3) {
push @blocked, 'cycle' unless @blocked;
splice(@blocked, 10, scalar(@blocked), '...') if @blocked > 10;
return ('blocked', join(', ', @blocked));
}
# prune cycle packages from blocked
if ($incycle) {
my $pkgsrc = $ctx->{'pkgsrc'};
my %cycs = map {(($pkgsrc->{$_} || {})->{'name'} || $_) => 1} @{$ctx->{'cychash'}->{$packid}};
@blocked = grep {!$cycs{$dep2src->{$_}}} @blocked;
}
if (@blocked) {
# print " - $packid ($buildtype)\n";
# print " blocked\n";
splice(@blocked, 10, scalar(@blocked), '...') if @blocked > 10;
return ('blocked', join(', ', @blocked));
}
# expand host deps
my $hdeps;
if ($ctx->{'bconf_host'} && !$p->{'native'}) {
my $subpacks = $ctx->{'subpacks'};
$hdeps = [ @{$p->{'dep_host'} || $p->{'dep'} || []}, @{$p->{'dep_native'} || []} ];
@$hdeps = Build::get_deps($ctx->{'bconf_host'}, $subpacks->{$p->{'name'}}, @$hdeps);
if (!shift @$hdeps) {
return ('unresolvable', 'host: '.join(', ', @$hdeps));
}
}
my $reason;
my @meta_s = stat("$dst/_meta");
# we store the lastcheck data in one string instead of an array
# with 4 elements to save precious memory
# srcmd5.metamd5.hdrmetamd5.statdata (32+32+32+x)
my $lastcheck = $ctx->{'lastcheck'};
my $mylastcheck = $lastcheck->{$packid};
my @meta;
if (!@meta_s || !$mylastcheck || substr($mylastcheck, 96) ne "$meta_s[9]/$meta_s[7]/$meta_s[1]") {
if (open(F, '<', "$dst/_meta")) {
@meta_s = stat F;
@meta = <F>;
close F;
chomp @meta;
$mylastcheck = substr($meta[0], 0, 32);
if (@meta == 2 && $meta[1] =~ /^fake/) {
$mylastcheck .= 'fakefakefakefakefakefakefakefake';
} else {
$mylastcheck .= Digest::MD5::md5_hex(join("\n", @meta));
}
$mylastcheck .= 'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx'; # fake hdrmetamd5
$mylastcheck .= "$meta_s[9]/$meta_s[7]/$meta_s[1]";
$lastcheck->{$packid} = $mylastcheck;
} else {
delete $lastcheck->{$packid};
undef $mylastcheck;
}
}
if (!$mylastcheck) {
return ('scheduled', [ { 'explain' => 'new build' }, $hdeps ]);
} elsif (substr($mylastcheck, 0, 32) ne ($p->{'verifymd5'} || $p->{'srcmd5'})) {
return ('scheduled', [ { 'explain' => 'source change', 'oldsource' => substr($mylastcheck, 0, 32) }, $hdeps ]);
} elsif ($p->{'force_rebuild'}) {
return ('scheduled', [ { 'explain' => 'forced rebuild' }, $hdeps ]);
} elsif (substr($mylastcheck, 32, 32) eq 'fakefakefakefakefakefakefakefake') {
my @s = stat("$dst/_meta");
if (!@s || $s[9] + 14400 > time()) {
return ('failed')
}
return ('scheduled', [ { 'explain' => 'retrying bad build' }, $hdeps ]);
} else {
my $rebuildmethod = $ctx->{'rebuild'} || 'transitive';
if ($rebuildmethod eq 'local' || $p->{'hasbuildenv'}) {
# rebuild on src changes only
goto relsynccheck;
}
# more work, check if dep rpm changed
if ($incycle == 1) {
# print " - $packid ($buildtype)\n";
# print " in cycle, no source change...\n";
return ('done');
}
my $check = substr($mylastcheck, 32, 32); # metamd5
my $dep2pkg = $p->{'native'} ? $ctx->{'dep2pkg_host'} : $ctx->{'dep2pkg'};
my $dep2pkg_host = $ctx->{'dep2pkg_host'};
$check .= $ctx->{'genmetaalgo'} if $ctx->{'genmetaalgo'};
$check .= $rebuildmethod;
$check .= $dep2pkg->{$_}->{'hdrmd5'} || 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0' for sort @$edeps;
$check .= $dep2pkg_host->{$_}->{'hdrmd5'} || 'd0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0' for sort @{$hdeps || []};
$check = Digest::MD5::md5_hex($check);
if ($check eq substr($mylastcheck, 64, 32)) {
# print " - $packid ($buildtype)\n";
# print " nothing changed\n";
goto relsynccheck;
}
substr($mylastcheck, 64, 32) = $check; # substitute new hdrmetamd5
# even more work, generate new meta, check if it changed
my $new_meta = genmeta($ctx, $p, $edeps, $hdeps);
if (Digest::MD5::md5_hex(join("\n", @$new_meta)) eq substr($mylastcheck, 32, 32)) {
# print " - $packid ($buildtype)\n";
# print " nothing changed (looked harder)\n";
$ctx->{'nharder'}++;
$lastcheck->{$packid} = $mylastcheck;
goto relsynccheck;
}
# something changed, read in old meta (if not already done)
if (!@meta && open(F, '<', "$dst/_meta")) {
@meta = <F>;
close F;
chomp @meta;
}
if ($rebuildmethod eq 'direct') {
@meta = grep {!/\//} @meta;
@$new_meta = grep {!/\//} @$new_meta;
}
if (@meta == @$new_meta && join('\n', @meta) eq join('\n', @$new_meta)) {
# print " - $packid ($buildtype)\n";
# print " nothing changed (looked harder)\n";
$ctx->{'nharder'}++;
if ($rebuildmethod eq 'direct') {
$lastcheck->{$packid} = $mylastcheck;
} else {
# should not happen, delete lastcheck cache
delete $lastcheck->{$packid};
}
goto relsynccheck;
}
my @diff = PBuild::Meta::diffsortedmd5(\@meta, $new_meta);
my $reason = PBuild::Meta::sortedmd5toreason(@diff);
return ('scheduled', [ { 'explain' => 'meta change', 'packagechange' => $reason }, $hdeps ] );
}
relsynccheck:
if ($ctx->{'relsynctrigger'}->{$packid}) {
return ('scheduled', [ { 'explain' => 'rebuild counter sync' }, $hdeps ] );
}
return ('done');
}
#
# Build dependency cycle handling
#
sub handlecycle {
my ($ctx, $packid, $cpacks, $cycpass, $packstatus) = @_;
my $incycle = 0;
my $cychash = $ctx->{'cychash'};
return ($packid, 0) unless $cychash->{$packid};
# do every package in the cycle twice:
# pass1: only build source changes
# pass2: normal build, but block if a pass1 package is building
# pass3: ignore
$incycle = $cycpass->{$packid};
if (!$incycle) {
# starting pass 1 (incycle == 1)
my @cycp = @{$cychash->{$packid}};
unshift @$cpacks, $cycp[0]; # pass3
unshift @$cpacks, @cycp; # pass2
unshift @$cpacks, @cycp; # pass1
$packid = shift @$cpacks;
$incycle = 1;
$cycpass->{$_} = $incycle for @cycp;
$cycpass->{$packid} = -1; # pass1 ended
} elsif ($incycle == -1) {
# starting pass 2 (incycle will be 2 or 3)
my @cycp = @{$cychash->{$packid}};
$incycle = (grep {$ctx->{'building'}->{$_}} @cycp) ? 3 : 2;
$cycpass->{$_} = $incycle for @cycp;
$cycpass->{$packid} = -2; # pass2 ended
} elsif ($incycle == -2) {
# starting pass 3 (incycle == 4)
my @cycp = @{$cychash->{$packid}};
$incycle = 4;
$cycpass->{$_} = $incycle for @cycp;
# propagate notready to all cycle packages
my $notready = $ctx->{'notready'};
my $pkgsrc = $ctx->{'pkgsrc'};
if (grep {$notready->{($pkgsrc->{$_} || {})->{'name'} || $_}} @cycp) {
$notready->{($pkgsrc->{$_} || {})->{'name'} || $_} ||= 1 for @cycp;
}
}
return ($packid, undef) if $incycle == 4; # ignore after pass1/2
return ($packid, undef) if $packstatus->{$packid} && $packstatus->{$packid} ne 'done' && $packstatus->{$packid} ne 'succeeded' && $packstatus->{$packid} ne 'failed'; # already decided
return ($packid, $incycle);
}
#
# Convert binary names to binary objects
#
sub dep2bins {
my ($ctx, @deps) = @_;
my $dep2pkg = $ctx->{'dep2pkg'};
for (@deps) {
my $q = $dep2pkg->{$_};
die("unknown binary $_\n") unless $q;
$_ = $q;
}
return \@deps;
}
sub dep2bins_host {
my ($ctx, @deps) = @_;
my $dep2pkg = $ctx->{'dep2pkg_host'} || $ctx->{'dep2pkg'};
for (@deps) {
my $q = $dep2pkg->{$_};
die("unknown binary $_\n") unless $q;
$_ = $q;
}
return \@deps;
}
#
# Start the build of a package
#
sub build {
my ($ctx, $p, $data, $builder) = @_;
my $packid = $p->{'pkg'};
my $reason = $data->[0];
my $hdeps = $data->[1];
#print Dumper($reason);
my %jobopts;
$jobopts{'nounchanged'} = 1 if $packid && $ctx->{'cychash'}->{$packid};
my @btdeps;
my $edeps = $p->{'dep_expanded'} || [];
my $bconf = $ctx->{'bconf_host'} || $ctx->{'bconf'};
my $buildtype = $p->{'buildtype'};
$buildtype = 'kiwi-image' if $buildtype eq 'kiwi';
my $kiwimode;
$kiwimode = $buildtype if $buildtype eq 'kiwi-image' || $buildtype eq 'kiwi-product' || $buildtype eq 'docker' || $buildtype eq 'fissile';
if ($p->{'buildtimeservice'}) {
for my $service (@{$p->{'buildtimeservice'} || []}) {
if ($bconf->{'substitute'}->{"obs-service:$service"}) {
push @btdeps, @{$bconf->{'substitute'}->{"obs-service:$service"}};
} else {
my $pkgname = "obs-service-$service";
$pkgname =~ s/_/-/g if $bconf->{'binarytype'} eq 'deb';
push @btdeps, $pkgname;
}
}
@btdeps = PBuild::Util::unify(@btdeps);
}
my @sysdeps = @btdeps;
unshift @sysdeps, grep {/^kiwi-.*:/} @{$p->{'dep'} || []} if $buildtype eq 'kiwi-image';
if (@sysdeps) {
@sysdeps = Build::get_sysbuild($bconf, $buildtype, [ @sysdeps ]); # cannot cache...
} else {
$ctx->{"sysbuild_$buildtype"} ||= [ Build::get_sysbuild($bconf, $buildtype) ];
@sysdeps = @{$ctx->{"sysbuild_$buildtype"}};
}
@btdeps = () if @sysdeps; # already included in sysdeps
my $genbuildreqs = $p->{'genbuildreqs'};
my @bdeps = grep {!/^\// || $bconf->{'fileprovides'}->{$_}} @{$p->{'prereq'} || []};
unshift @bdeps, '--directdepsend--' if @bdeps;
unshift @bdeps, @{$p->{'dep_native'} || []};
unshift @bdeps, @{$genbuildreqs->[1]} if $genbuildreqs;
if (!$kiwimode && $ctx->{'bconf_host'}) {
unshift @bdeps, @{$p->{'dep_host'} || $p->{'dep'} || []}, @btdeps;
} else {
unshift @bdeps, @{$p->{'dep'} || []}, @btdeps;
}
push @bdeps, '--ignoreignore--' if @sysdeps || $buildtype eq 'simpleimage';
my $opts = $ctx->{'opts'};
if ($opts->{'ccache'} && ($buildtype eq 'arch' || $buildtype eq 'spec' || $buildtype eq 'dsc')) {
my $opackid = $packid;
$opackid = $p->{'releasename'} if $p->{'releasename'};
if (!exists($bconf->{'buildflags:useccache'}) || grep {$_ eq "useccache:$opackid" || $_ eq "useccache:$packid"} @{$bconf->{'buildflags'} || []}) {
my $ccache_type = $opts->{'ccache-type'} || 'ccache';
push @bdeps, @{$bconf->{'substitute'}->{"build-packages:$ccache_type"} || [ $ccache_type ] };
$jobopts{'ccache'} = 1;
$jobopts{'ccache-type'} = $opts->{'ccache-type'};
}
}
if ($kiwimode || $buildtype eq 'buildenv' || $buildtype eq 'preinstallimage') {
@bdeps = (1, @$edeps); # reuse edeps packages, no need to expand again
} else {
@bdeps = Build::get_build($bconf, $ctx->{'subpacks'}->{$p->{'name'}}, @bdeps);
}
if (!shift(@bdeps)) {
return ('unresolvable', join(', ', @bdeps));
}
if (@sysdeps && !shift(@sysdeps)) {
return ('unresolvable', 'sysdeps:' . join(', ', @sysdeps));
}
my $dep2pkg = $ctx->{'dep2pkg_host'} || $ctx->{'dep2pkg'};
my @pdeps = Build::get_preinstalls($bconf);
my @vmdeps = Build::get_vminstalls($bconf);
my @missing = grep {!$dep2pkg->{$_}} (@pdeps, @vmdeps);
if (@missing) {
my $missing = join(', ', sort(PBuild::Util::unify(@missing)));
return ('unresolvable', "missing pre/vminstalls: $missing");
}
my $tdeps;
$tdeps = [ @$edeps ] if !$kiwimode && !$p->{'native'} && $ctx->{'bconf_host'};
my $oldsrcmd5 = $p->{'srcmd5'};
$ctx->{'assetmgr'}->getremoteassets($p);
return ('recheck', 'assets changed') if $p->{'srcmd5'} ne $oldsrcmd5;
return ('broken', $p->{'error'}) if $p->{'error'}; # missing assets
my $bins;
if ($kiwimode && $ctx->{'bconf_host'}) {
$bins = dep2bins_host($ctx, PBuild::Util::unify(@pdeps, @vmdeps, @sysdeps));
push @$bins, @{dep2bins($ctx, PBuild::Util::unify(@bdeps))};
} else {
$bins = dep2bins_host($ctx, PBuild::Util::unify(@pdeps, @vmdeps, @sysdeps, @bdeps));
push @$bins, @{dep2bins($ctx, PBuild::Util::unify(@$tdeps))} if $tdeps;
}
$ctx->{'repomgr'}->getremotebinaries($bins);
my $readytime = time();
my $job;
eval {
$job = PBuild::Job::createjob($ctx, $builder->{'name'}, $builder->{'nbuilders'}, $builder->{'root'}, $p, \@bdeps, \@pdeps, \@vmdeps, \@sysdeps, $tdeps, \%jobopts);
};
if ($@) {
chomp $@;
return ('broken', $@);
}
$job->{'readytime'} = $readytime;
$job->{'reason'} = $reason;
$job->{'hostarch'} = $ctx->{'hostarch'};
# calculate meta (again) as remote binaries have been replaced
$job->{'meta'} = genmeta($ctx, $p, $edeps, $hdeps);
$builder->{'job'} = $job;
return ('building', $job);
}
1;
07070100000004000081a400000000000000000000000163e504b900000e4f000000000000000000000000000000000000001400000000PBuild/Container.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 PBuild::Container;
use Digest::MD5 ();
use PBuild::Util;
use PBuild::Verify;
eval { require JSON::XS };
*JSON::XS::decode_json = sub {die("JSON::XS is not available\n")} unless defined &JSON::XS::decode_json;
use strict;
sub containerinfo2nevra {
my ($d) = @_;
my $lnk = {};
$lnk->{'name'} = "container:$d->{'name'}";
$lnk->{'version'} = defined($d->{'version'}) ? $d->{'version'} : '0';
$lnk->{'release'} = defined($d->{'release'}) ? $d->{'release'} : '0';
$lnk->{'arch'} = defined($d->{'arch'}) ? $d->{'arch'} : 'noarch';
return $lnk;
}
sub containerinfo2obsbinlnk {
my ($dir, $containerinfo, $packid) = @_;
my $d = readcontainerinfo($dir, $containerinfo);
return unless $d;
my $lnk = containerinfo2nevra($d);
# need to have a source so that it goes into the :full tree
$lnk->{'source'} = $lnk->{'name'};
# add self-provides
push @{$lnk->{'provides'}}, "$lnk->{'name'} = $lnk->{'version'}";
for my $tag (@{$d->{tags}}) {
push @{$lnk->{'provides'}}, "container:$tag" unless "container:$tag" eq $lnk->{'name'};
}
eval { PBuild::Verify::verify_nevraquery($lnk) };
return undef if $@;
local *F;
if ($d->{'tar_md5sum'}) {
# this is a normalized container
$lnk->{'hdrmd5'} = $d->{'tar_md5sum'};
$lnk->{'lnk'} = $d->{'file'};
return $lnk;
}
return undef unless open(F, '<', "$dir/$d->{'file'}");
my $ctx = Digest::MD5->new;
$ctx->addfile(*F);
close F;
$lnk->{'hdrmd5'} = $ctx->hexdigest();
$lnk->{'lnk'} = $d->{'file'};
return $lnk;
}
sub readcontainerinfo {
my ($dir, $containerinfo) = @_;
return undef unless -e "$dir/$containerinfo";
return undef unless (-s _) < 100000;
my $m = PBuild::Util::readstr("$dir/$containerinfo");
my $d;
eval { $d = JSON::XS::decode_json($m); };
return undef unless $d && ref($d) eq 'HASH';
my $tags = $d->{'tags'};
$tags = [] unless $tags && ref($tags) eq 'ARRAY';
for (@$tags) {
$_ = undef unless defined($_) && ref($_) eq '';
}
@$tags = grep {defined($_)} @$tags;
my $name = $d->{'name'};
$name = undef unless defined($name) && ref($name) eq '';
if (!defined($name) && @$tags) {
# no name specified, get it from first tag
$name = $tags->[0];
$name =~ s/[:\/]/-/g;
}
$d->{name} = $name;
my $file = $d->{'file'};
$d->{'file'} = $file = undef unless defined($file) && ref($file) eq '';
delete $d->{'disturl'} unless defined($d->{'disturl'}) && ref($d->{'disturl'}) eq '';
delete $d->{'buildtime'} unless defined($d->{'buildtime'}) && ref($d->{'buildtime'}) eq '';
delete $d->{'imageid'} unless defined($d->{'imageid'}) && ref($d->{'imageid'}) eq '';
return undef unless defined($name) && defined($file);
eval {
PBuild::Verify::verify_simple($file);
PBuild::Verify::verify_filename($file);
};
return undef if $@;
return $d;
}
1;
07070100000005000081a400000000000000000000000163e504b900001f85000000000000000000000000000000000000000f00000000PBuild/Cpio.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 PBuild::Cpio;
use PBuild::Util;
use strict;
# cpiotype: 1=pipe 2=char 4=dir 6=block 8=file 10=symlink 12=socket
sub cpio_make {
my ($ent, $s) = @_;
return ("07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000b00000000TRAILER!!!\0\0\0\0") if !$ent;
my $name = $ent->{'name'};
my $mode = $ent->{'mode'};
my $cpiotype = $ent->{'cpiotype'};
my $ino = $ent->{'inode'};
my $mtime = $ent->{'mtime'};
my $size = $ent->{'size'};
$cpiotype = (($mode || 0) >> 12) || 8 unless defined $cpiotype;
$mode = $cpiotype == 4 ? 0x1ed : 0x1a4 unless defined $mode;
$mode = ($mode & ~0xf000) | ($cpiotype << 12);
$mtime = $s ? $s->[9] : time() unless defined $mtime;
$size = $s ? $s->[7] : 0 unless defined $size;
$ino = ($ino || 0) & 0xffffffff;
my $h = sprintf("070701%08x%08x000000000000000000000001%08x", $ino, $mode, $mtime);
if ($size >= 0xffffffff) {
# build service extension, size is in rmajor/rminor
my $top = int($s->[7] / 4294967296);
$size -= $top * 4294967296;
$h .= sprintf("ffffffff0000000000000000%08x%08x", $top, $size);
} else {
$h .= sprintf("%08x00000000000000000000000000000000", $size);
}
$h .= sprintf("%08x", length($name) + 1);
$h .= "00000000$name\0";
$h .= substr("\0\0\0\0", (length($h) & 3)) if length($h) & 3;
my $pad = $size % 4 ? substr("\0\0\0\0", $size % 4) : '';
return ($h, $pad);
}
sub copyout {
my ($ofd, $file, $size) = @_;
my $fd;
open($fd, '<', $file) || die("$file: $!\n");
while ($size > 0) {
my $d;
sysread($fd, $d, $size > 8192 ? 8192 : $size, 0);
die("$file: unexpected EOF\n") unless length($d);
print $ofd $d or die("cpio write: $!\n");
$size -= length($d);
}
close($fd);
}
sub copyin {
my ($ifd, $file, $size) = @_;
my $fd;
open($fd, '>', $file) || die("$file: $!\n");
while ($size > 0) {
my $chunk = cpio_read($ifd, $size > 65536 ? 65536 : $size);
print $fd $chunk or die("$file write: $!\n");
$size -= length($chunk);
}
close($fd) || die("$file: $!\n");
}
sub skipin {
my ($ifd, $size) = @_;
while ($size > 0) {
my $chunk = cpio_read($ifd, $size > 65536 ? 65536 : $size);
$size -= length($chunk);
}
}
sub cpio_create {
my ($fd, $dir, %opts) = @_;
my @todo;
my $prefix = defined($opts{'prefix'}) ? $opts{'prefix'} : '';
my $prefixdir;
if ($prefix =~ /(.+)\/$/) {
$prefixdir = $1;
my @s = stat("$dir/.");
die("$dir: $!\n") unless @s;
$s[7] = 0;
unshift @todo, [ '', @s ];
}
if ($opts{'dircontent'}) {
unshift @todo, @{$opts{'dircontent'}};
} else {
unshift @todo, sort(PBuild::Util::ls($dir));
}
my $ino = 0;
while (@todo) {
my $name = shift @todo;
my @s;
if (!ref($name)) {
@s = lstat("$dir/$name");
die("$dir/$name: $!\n") unless @s;
}
my $ent;
if (ref($name)) {
$ent = { 'cpiotype' => 4, 'size' => 0 };
($name, @s) = @$name;
} elsif (-l _) {
my $lnk = readlink("$dir/$name");
die("readlink $dir/$name: $!\n") unless defined $lnk;
$ent = { 'cpiotype' => 10, 'size' => length($lnk), 'data' => $lnk };
} elsif (-d _) {
unshift @todo, [ $name, @s ];
unshift @todo, map {"$name/$_"} sort(PBuild::Util::ls("$dir/$name"));
next;
} elsif (-f _) {
$ent = { 'cpiotype' => 8, 'size' => $s[7] };
} else {
die("unsupported file type $s[2]: $dir/$name\n");
}
$ent->{'mode'} = $s[2] & 0xfff;
$ent->{'name'} = $name eq '' ? $prefixdir : "$prefix$name";
$ent->{'mtime'} = $opts{'mtime'} if defined $opts{'mtime'};
$ent->{'inode'} = $ino++;
my ($h, $pad) = cpio_make($ent, \@s);
print $fd $h;
print $fd $ent->{'data'} if defined $ent->{'data'};
copyout($fd, "$dir/$name", $ent->{'size'}) if $ent->{'cpiotype'} == 8 && $ent->{'size'};
print $fd $pad or die("cpio write: $!\n");
}
print $fd cpio_make() or die("cpio write: $!\n");
}
sub cpio_read {
my ($fd, $l) = @_;
my $r = '';
die("bad cpio file\n") unless !$l || (read($fd, $r, $l) || 0) == $l;
return $r;
}
sub cpio_parse {
my ($cpiohead) = @_;
die("not a 'SVR4 no CRC ascii' cpio\n") unless substr($cpiohead, 0, 6) eq '070701';
my $mode = hex(substr($cpiohead, 14, 8));
my $mtime = hex(substr($cpiohead, 46, 8));
my $size = hex(substr($cpiohead, 54, 8));
my $pad = (4 - ($size % 4)) % 4;
my $namesize = hex(substr($cpiohead, 94, 8));
my $namepad = (6 - ($namesize % 4)) % 4;
if ($size == 0xffffffff) {
# build service extension, size is in rmajor/rminor
$size = hex(substr($cpiohead, 86, 8));
$pad = (4 - ($size % 4)) % 4;
$size += hex(substr($cpiohead, 78, 8)) * 4294967296;
die("bad size extension\n") if $size < 0xffffffff;
}
die("ridiculous long filename\n") if $namesize > 8192;
my $ent = { 'namesize' => $namesize , 'size' => $size, 'mtime' => $mtime, 'mode' => $mode, 'cpiotype' => ($mode >> 12 & 0xf) };
return ($ent, $namesize, $namepad, $size, $pad);
}
sub set_mode_mtime {
my ($ent, $outfile, $opts) = @_;
if ($opts->{'set_mode'}) {
chmod($ent->{'mode'} & 07777, $outfile);
}
if ($opts->{'set_mtime'}) {
utime($ent->{'mtime'}, $ent->{'mtime'}, $outfile);
}
}
sub cpio_extract {
my ($cpiofile, $out, %opts) = @_;
my $fd;
my $extract = $opts{'extract'};
open($fd, '<', $cpiofile) || die("$cpiofile: $!\n");
my %symlinks;
while (1) {
my $cpiohead = cpio_read($fd, 110);
my ($ent, $namesize, $namepad, $size, $pad) = cpio_parse($cpiohead);
my $name = substr(cpio_read($fd, $namesize + $namepad), 0, $namesize);
$name =~ s/\0.*//s;
if (!$size && $name eq 'TRAILER!!!') {
die("$cpiofile: no $extract entry\n") if defined($extract) && !$opts{'missingok'};
last;
}
$name =~ s/^\.\///s;
$ent->{'name'} = $name;
my $outfile = "$out/$name";
$outfile = $ent->{'cpiotype'} == 8 && $name eq $extract ? $out : undef if defined $extract;
$outfile = $out->($ent, undef) if defined($outfile) && ref($out) eq 'CODE';
if (!defined($outfile)) {
skipin($fd, $size + $pad);
next;
}
PBuild::Util::mkdir_p($1) if $name =~ /\// && $outfile =~ /(.*)\//;
if ($ent->{'cpiotype'} == 4) {
if (-l $outfile || ! -d _) {
mkdir($outfile, 0755) || die("mkdir $outfile: $!\n");
}
} elsif ($ent->{'cpiotype'} == 10) {
die("illegal symlink size\n") if $size > 65535;
my $lnk = cpio_read($fd, $size);
unlink($outfile);
if ($opts{'postpone_symlinks'}) {
$symlinks{$outfile} = $lnk;
} else {
symlink($lnk, $outfile) || die("symlink $lnk $outfile: $!\n");
}
} elsif ($ent->{'cpiotype'} == 8) {
unlink($outfile);
copyin($fd, $outfile, $size);
} else {
die("unsupported cpio type $ent->{'cpiotype'}\n");
}
set_mode_mtime($ent, $outfile, \%opts) if $ent->{'cpiotype'} != 10;
if (ref($out) eq 'CODE') {
last if $out->($ent, $outfile);
}
last if defined $extract;
cpio_read($fd, $pad) if $pad;
}
for my $outfile (sort {$b cmp $a} keys %symlinks) {
unlink($outfile);
symlink($symlinks{$outfile}, $outfile) || die("symlink $symlinks{$outfile} $outfile: $!\n");
}
close($fd);
}
1;
07070100000006000081a400000000000000000000000163e504b900001547000000000000000000000000000000000000001200000000PBuild/Depsort.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 PBuild::Depsort;
use strict;
# Tarjan's SCC algorithm using a stack instead of recursion
sub find_sccs {
my ($vert, $edg) = @_;
my %low;
my @sccs;
my $idx = 1;
my @todo = map {($_, 0)} @$vert;
while (@todo) {
my ($node, $myidx) = splice(@todo, 0, 2);
if (!$myidx) {
next if $low{$node};
$low{$node} = $myidx = $idx++;
}
my @notyet = grep {!$low{$_}} @{$edg->{$node} || []};
if (@notyet) {
unshift @todo, (map {($_, 0)} @notyet), $node, $myidx;
next;
}
for (map {$low{$_}} @{$edg->{$node} || []}) {
$low{$node} = $_ if $_ > 0 && $_ < $low{$node};
}
if ($low{$node} == $myidx) {
my @collect = $node;
my @scc;
while (@collect) {
my $n = shift @collect;
next if $low{$n} < 0;
$low{$n} = -1;
push @scc, $n;
unshift @collect, grep {$low{$_} > 0} @{$edg->{$n} || []};
}
push @sccs, \@scc if @scc > 1;
}
}
return @sccs;
}
#
# Sort packages by dependencies
#
sub depsort {
my ($depsp, $mapp, $cycp, $sccs, @packs) = @_;
return @packs if @packs < 2;
my %deps;
my %rdeps;
my %needed;
# map and unify dependencies, create rdeps and needed
my %known = map {$_ => 1} @packs;
die("sortpacks: input not unique\n") if @packs != keys(%known);
for my $p (@packs) {
my @fdeps = @{$depsp->{$p} || []};
@fdeps = map {$mapp->{$_} || $_} @fdeps if $mapp;
@fdeps = grep {$known{$_}} @fdeps;
my %fdeps = ($p => 1); # no self reference
@fdeps = grep {!$fdeps{$_}++} @fdeps;
$deps{$p} = \@fdeps;
$needed{$p} = @fdeps;
push @{$rdeps{$_}}, $p for @fdeps;
}
undef %known; # free memory
@packs = sort {$needed{$a} <=> $needed{$b} || $a cmp $b} @packs;
my @good;
my @res;
# the big sort loop
while (@packs) {
@good = grep {$needed{$_} == 0} @packs;
if (@good) {
@packs = grep {$needed{$_}} @packs;
push @res, @good;
for my $p (@good) {
$needed{$_}-- for @{$rdeps{$p}};
}
next;
}
die unless @packs > 1;
# uh oh, cycle alert. find and remove all cycles.
if ($sccs) {
push @$sccs, find_sccs(\@packs, \%deps);
undef $sccs;
}
my %notdone = map {$_ => 1} @packs;
$notdone{$_} = 0 for @res; # already did those
my @todo = @packs;
while (@todo) {
my $v = shift @todo;
if (ref($v)) {
$notdone{$$v} = 0; # finished this one
next;
}
my $s = $notdone{$v};
next unless $s;
my @e = grep {$notdone{$_}} @{$deps{$v}};
if (!@e) {
$notdone{$v} = 0; # all deps done, mark as finished
next;
}
if ($s == 1) {
$notdone{$v} = 2; # now under investigation
unshift @todo, @e, \$v;
next;
}
# reached visited package, found a cycle!
my @cyc = ();
my $cycv = $v;
# go back till $v is reached again
while(1) {
die unless @todo;
$v = shift @todo;
next unless ref($v);
$v = $$v;
$notdone{$v} = 1 if $notdone{$v} == 2;
unshift @cyc, $v;
last if $v eq $cycv;
}
unshift @todo, $cycv;
# print "cycle: ".join(' -> ', @cyc)."\n";
push @$cycp, [ @cyc ] if $cycp;
my $breakv = (sort {$needed{$a} <=> $needed{$b} || $a cmp $b} @cyc)[0];
push @cyc, $cyc[0];
shift @cyc while $cyc[0] ne $breakv;
$v = $cyc[1];
# print " breaking with $breakv -> $v\n";
$deps{$breakv} = [ grep {$_ ne $v} @{$deps{$breakv}} ];
$rdeps{$v} = [ grep {$_ ne $breakv} @{$rdeps{$v}} ];
$needed{$breakv}--;
}
}
return @res;
}
#
# Sort packages by dependencies mapped to source packages
#
sub depsort2 {
my ($deps, $dep2src, $pkg2src, $cycles, $sccs, @packs) = @_;
my %src2pkg = reverse(%$pkg2src);
my %pkgdeps;
my @dups;
if (keys(%src2pkg) != keys (%$pkg2src)) {
@dups = grep {$src2pkg{$pkg2src->{$_}} ne $_} reverse(keys %$pkg2src);
}
if (@dups) {
push @dups, grep {defined($_)} map {delete $src2pkg{$pkg2src->{$_}}} @dups;
@dups = sort(@dups);
#print "src2pkg dups: @dups\n";
push @{$src2pkg{$pkg2src->{$_}}}, $_ for @dups;
for my $pkg (keys %$deps) {
$pkgdeps{$pkg} = [ map {ref($_) ? @$_ : $_} map { $src2pkg{$dep2src->{$_} || $_} || $dep2src->{$_} || $_} @{$deps->{$pkg}} ];
}
} else {
for my $pkg (keys %$deps) {
$pkgdeps{$pkg} = [ map { $src2pkg{$dep2src->{$_} || $_} || $dep2src->{$_} || $_} @{$deps->{$pkg}} ];
}
}
return depsort(\%pkgdeps, undef, $cycles, $sccs, @packs);
}
1;
07070100000007000081a400000000000000000000000163e504b900000711000000000000000000000000000000000000001100000000PBuild/Distro.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 PBuild::Distro;
use strict;
use Build;
sub guess_distro_from_rpm {
my ($arch) = @_;
my $distribution;
my @requires;
my $fd;
open($fd, '-|', 'rpm', '-q', '--qf', 'Distribution = %{DISTRIBUTION}\n', '--requires', 'rpm') || die;
while (<$fd>) {
chomp;
if (/^Distribution = (.*)$/ && !defined($distribution)) {
$distribution = $1;
} else {
push @requires, $_;
}
}
close($fd);
my $dist = Build::dist_canon($distribution, $arch);
# need some extra work for sles11 and sles15 :(
if ($dist =~ /^sles11-/) {
$dist =~ s/^sles11-/sles11sp2-/ if grep {/^liblzma/} @requires;
}
if ($dist =~ /^sles15-/) {
$dist =~ s/^sles15-/sles15sp2-/ if grep {/^libgcrypt/} @requires;
}
return $dist;
}
sub guess_distro {
my ($arch) = @_;
my $dist;
if (-x '/bin/rpm' || -x '/usr/bin/rpm') {
$dist = guess_distro_from_rpm($arch);
}
die("could not determine local dist\n") unless $dist;
return $dist;
}
1;
07070100000008000081a400000000000000000000000163e504b900001182000000000000000000000000000000000000001100000000PBuild/Expand.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 PBuild::Expand;
use strict;
use Build;
use PBuild::Modules;
#
# configure the expander with the available repos
#
sub configure_repos {
my ($bconf, $repos) = @_;
my %packs;
my %packs_done;
my $binarytype = $bconf->{'binarytype'} || '';
my $verscmp = $binarytype eq 'deb' ? \&Build::Deb::verscmp : \&Build::Rpm::verscmp;
# this is what perl-BSSolv does. It is different to the
# code in expanddeps!
for my $repo (@$repos) {
my $bins = $repo->{'bins'} || [];
if (@$bins && $bins->[-1]->{'name'} eq 'moduleinfo:' && $bins->[-1]->{'data'}) {
my $err = PBuild::Modules::missingmodules($bconf->{'modules'}, $bins->[-1]->{'data'});
die("module configuration error: $err\n") if $err;
$bins = PBuild::Modules::prune_to_modules($bconf->{'modules'}, $bins->[-1]->{'data'}, $bins);
}
for my $bin (@$bins) {
my $n = $bin->{'name'};
next if $packs_done{$n};
my $obin = $packs{$n};
if ($obin) {
my $evr = $bin->{'version'};
$evr = "$bin->{'epoch'}:$evr" if $bin->{'epoch'};
$evr .= "-$bin->{'release'}" if defined $bin->{'release'};
my $oevr = $obin->{'version'};
$oevr = "$obin->{'epoch'}:$oevr" if $obin->{'epoch'};
$oevr .= "-$obin->{'release'}" if defined $obin->{'release'};
my $arch = $bin->{'arch'} || '';
$arch = 'noarch' if !$arch || $arch eq 'all' || $arch eq 'any';
my $oarch = $obin->{'arch'} || '';
$oarch = 'noarch' if !$oarch || $oarch eq 'all' || $oarch eq 'any';
if ($oevr ne $evr) {
next if ($verscmp->($oevr, $evr) || $oevr cmp $evr) >= 0;
} elsif ($arch ne $oarch) {
next if $arch eq 'noarch' && $oarch ne 'noarch';
next if !($oarch eq 'noarch' && $arch ne 'noarch') && ($oarch cmp $arch) >= 0;
}
}
$packs{$n} = $bin;
}
%packs_done = %packs;
}
delete $packs{'moduleinfo:'};
Build::forgetdeps($bconf); # free mem first
Build::readdeps($bconf, undef, \%packs);
return \%packs;
}
#
# expand dependencies of a single package (image case)
#
sub expand_deps_image {
my ($p, $bconf, $subpacks, $cross) = @_;
delete $p->{'dep_experror'};
if ($p->{'error'}) {
$p->{'dep_expanded'} = [];
return;
}
my @deps = @{$p->{'dep'} || []};
push @deps, '--ignoreignore--' unless ($p->{'buildtype'} || '') eq 'preinstallimage';
my ($ok, @edeps) = Build::get_build($bconf, [], @deps);
if (!$ok) {
delete $p->{'dep_expanded'};
$p->{'dep_experror'} = join(', ', @edeps);
} else {
$p->{'dep_expanded'} = \@edeps;
}
}
#
# expand dependencies of a single package
#
sub expand_deps {
my ($p, $bconf, $subpacks, $cross) = @_;
my $buildtype = $p->{'buildtype'} || '';
return expand_deps_image($p, $bconf, $subpacks, $cross) if $buildtype eq 'kiwi' || $buildtype eq 'docker' || $buildtype eq 'fissile' || $buildtype eq 'preinstallimage';
delete $p->{'dep_experror'};
if ($p->{'error'}) {
$p->{'dep_expanded'} = [];
return;
}
my @deps = @{$p->{'dep'} || []};
if ($buildtype eq 'aggregate' || $buildtype eq 'patchinfo') {
$p->{'dep_expanded'} = \@deps;
return;
}
if ($p->{'genbuildreqs'}) {
push @deps, @{$p->{'genbuildreqs'}};
}
my @edeps;
if ($cross) {
my @native;
@edeps = Build::get_sysroot($bconf, $subpacks->{$p->{'name'}}, '--extractnative--', \@native, @deps);
$p->{'dep_native'} = \@native;
} else {
@edeps = Build::get_deps($bconf, $subpacks->{$p->{'name'}}, @deps);
}
if (!shift @edeps) {
delete $p->{'dep_expanded'};
$p->{'dep_experror'} = join(', ', @edeps);
} else {
$p->{'dep_expanded'} = \@edeps;
}
}
1;
07070100000009000081a400000000000000000000000163e504b900000ba1000000000000000000000000000000000000001700000000PBuild/ExportFilter.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 PBuild::ExportFilter;
use strict;
use PBuild::Verify;
my %default_exportfilters = (
'i586' => {
'\.x86_64\.rpm$' => [ 'x86_64' ],
'\.ia64\.rpm$' => [ 'ia64' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'x86_64' => {
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'ppc' => {
'\.ppc64\.rpm$' => [ 'ppc64' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'ppc64' => {
'\.ppc\.rpm$' => [ 'ppc' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'sparc' => {
# discard is intended - sparcv9 target is better suited for 64-bit baselibs
'\.sparc64\.rpm$' => [],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'sparcv8' => {
# discard is intended - sparcv9 target is better suited for 64-bit baselibs
'\.sparc64\.rpm$' => [],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'sparcv9' => {
'\.sparc64\.rpm$' => [ 'sparc64' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'sparcv9v' => {
'\.sparc64v\.rpm$' => [ 'sparc64v' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'sparc64' => {
'\.sparcv9\.rpm$' => [ 'sparcv9' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
'sparc64v' => {
'\.sparcv9v\.rpm$' => [ 'sparcv9v' ],
'-debuginfo-.*\.rpm$' => [],
'-debugsource-.*\.rpm$' => [],
},
);
sub compile_exportfilter {
my ($filter) = @_;
return undef unless $filter;
my @res;
for my $f (@$filter) {
eval {
$_ eq '.' || PBuild::Verify::verify_arch($_) for @{$f->[1] || []};
push @res, [ qr/$f->[0]/, $f->[1] ];
};
}
return \@res;
}
sub calculate_exportfilter {
my ($bconf, $arch) = @_;
my $filter = $bconf->{'exportfilter'};
undef $filter if $filter && !%$filter;
$arch = 'i586' if $arch eq 'i686';
$filter ||= $default_exportfilters{$arch};
$filter = [ map {[$_, $filter->{$_}]} reverse sort keys %$filter ] if $filter;
return compile_exportfilter($filter);
}
1;
0707010000000a000081a400000000000000000000000163e504b900003e0b000000000000000000000000000000000000000e00000000PBuild/Job.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 PBuild::Job;
use strict;
use Time::HiRes ();
use PBuild::Util;
use PBuild::Cando;
use PBuild::Verify;
use PBuild::RepoMgr;
#
# Fork and exec the build tool
#
sub forkjob {
my ($opts, $args, $stderrfile) = @_;
if (!$opts->{'shell'}) {
my $pid = PBuild::Util::xfork();
return $pid if $pid;
if (!$opts->{'showlog'}) {
open(STDIN, '<', '/dev/null');
open(STDOUT, '>', '/dev/null');
if ($stderrfile) {
open(STDERR, '>', $stderrfile) || die("$stderrfile: $!\n");
} else {
open(STDERR, '>&STDOUT');
}
}
}
exec(@$args);
die("$args->[0]: $!\n");
}
#
# Update the logfile_lines element by counting lines in the logfile
#
sub updatelines {
my ($job) = @_;
my $logfile = $job->{'logfile'};
return unless $logfile;
my @s = stat($logfile);
my $newsize = @s ? $s[7] : 0;
my $oldsize = $job->{'logfile_oldsize'} || 0;
return if $oldsize < 0 || $newsize <= $oldsize;
my $fd;
if (open($fd, '<', $logfile)) {
sysseek($fd, $oldsize, 0);
while ($oldsize < $newsize) {
my $b = '';
my $r = sysread($fd, $b, $newsize - $oldsize > 8192 ? 8192 : $newsize - $oldsize);
last if $r < 0;
$oldsize += $r;
$job->{'logfile_lines'} += $b =~ tr/\n/\n/;
}
close $fd;
} else {
$oldsize = -1;
}
$job->{'logfile_oldsize'} = $oldsize;
}
#
# Wait for one or more build jobs to finish
#
sub waitjob {
my ($opts, @jobs) = @_;
local $| = 1;
my $oldmsg;
while (1) {
Time::HiRes::sleep(.2);
my $msg = '[';
for my $job (@jobs) {
updatelines($job);
if (($job->{'nbuilders'} || 1) > 1) {
$msg .= " $job->{'name'}:$job->{'logfile_lines'}";
} else {
$msg .= " $job->{'logfile_lines'}";
}
my $r = waitpid($job->{'pid'}, POSIX::WNOHANG);
next unless $r && $r == $job->{'pid'};
my $waitstatus = $?;
$waitstatus = $waitstatus & 255 ? -1 : $waitstatus >> 8;
$job->{'waitstatus'} = $waitstatus;
$job->{'endtime'} = time();
delete $job->{'pid'};
print "\n" if $oldmsg;
return $job;
}
$msg .= ' ]';
print "\r$msg" if !$opts->{'showlog'} && (!$oldmsg || $oldmsg ne $msg);
$oldmsg = $msg;
}
}
#
# Search for build artifacts
#
sub collect_result {
my ($p, $buildroot) = @_;
my @d;
push @d, map {"RPMS/$_"} sort(PBuild::Util::ls("$buildroot/.build.packages/RPMS"));
push @d, 'SRPMS';
@d = ('DEBS') if $p->{'recipe'} =~ /(?:\.dsc|build\.collax)$/ || $p->{'recipe'} eq 'debian/control' || $p->{'recipe'} eq 'debian.control';
if (-d "$buildroot/.build.packages/SDEBS") {
@d = map {"DEBS/$_"} sort(PBuild::Util::ls("$buildroot/.build.packages/DEBS")); # assume debbuild
push @d, 'SDEBS';
}
@d = ('ARCHPKGS') if $p->{'recipe'} =~ /PKGBUILD$/;
@d = ('KIWI') if $p->{'recipe'} =~ /\.kiwi$/;
@d = ('DOCKER') if $p->{'recipe'} =~ /Dockerfile$/;
@d = ('FISSILE') if $p->{'recipe'} =~ /fissile\.yml$/;
@d = ('HELM') if $p->{'recipe'} =~ /Chart\.yaml$/;
push @d, 'OTHER';
my @send;
for my $d ('.', @d) {
my @files = sort(PBuild::Util::ls("$buildroot/.build.packages/$d"));
@files = grep {$_ ne 'same_result_marker' && $_ ne '.kiwitree'} @files;
@files = grep {! -l "$buildroot/.build.packages/$d/$_" && -f _} @files;
push @send, map {"$buildroot/.build.packages/$d/$_"} @files;
}
my %send = map {(split('/', $_))[-1] => $_} @send;
for my $f (sort keys %send) {
if ($f =~ /^\./) {
delete $send{$f};
next;
}
if ($f =~ /^_/) {
next if $f eq '_statistics';
next if $f eq '_ccache.tar';
delete $send{$f};
next;
}
}
delete $send{'_log'};
return \%send;
}
#
# Copy the package sources into the build root
#
sub copy_sources {
my ($p, $srcdir) = @_;
# for kiwi/docker we need to copy the sources to $buildroot/.build-srcdir
# so that we can set up the "repos" and "containers" directories
PBuild::Util::rm_rf($srcdir);
PBuild::Util::mkdir_p($srcdir);
for (sort keys %{$p->{'files'}}) {
if (/(.*)\/$/) {
PBuild::Util::cp_a("$p->{'dir'}/$1", "$srcdir/$1");
} else {
PBuild::Util::cp("$p->{'dir'}/$_", "$srcdir/$_");
}
}
}
#
# Export upstream tarballs for git-buildpackage
#
sub export_origtar {
my ($p, $srcdir, $opts) = @_;
return unless -d "$p->{'dir'}/.git";
system("$opts->{'libbuild'}/export_debian_orig_from_git", $p->{'dir'}, "$srcdir/build.origtar") && die("export_orig_from_git $p->{'dir'} $srcdir/build.origtar: $?\n");
}
#
# Create a new build job
#
# ctx usage: opts hostarch bconf arch repos dep2pkg buildconfig debuginfo
#
sub createjob {
my ($ctx, $jobname, $nbuilders, $buildroot, $p, $bdeps, $pdeps, $vmdeps, $sysdeps, $tdeps, $jobopts) = @_;
my $opts = { %{$ctx->{'opts'}} }; # create copy so we can modify
my $hostarch = $opts->{'hostarch'};
my $arch = $p->{'native'} ? $hostarch : $ctx->{'arch'};
my $bconf = $ctx->{'bconf'};
my $helperarch = $bconf->{'hostarch'} || $arch;
die("don't know how to build arch $helperarch\n") unless $PBuild::Cando::knownarch{$helperarch};
my $helper = '';
/^\Q$helperarch\E:(.*)$/ && ($helper = $1) for @{$PBuild::Cando::cando{$hostarch}};
my %runscripts = map {$_ => 1} Build::get_runscripts($bconf);
my %bdeps = map {$_ => 1} @$bdeps;
my %pdeps = map {$_ => 1} @$pdeps;
my %vmdeps = map {$_ => 1} @$vmdeps;
my %sysdeps = map {$_ => 1} @$sysdeps;
my @alldeps;
my $kiwimode = $p->{'buildtype'} eq 'kiwi' || $p->{'buildtype'} eq 'docker' || $p->{'buildtype'} eq 'fissile' ? $p->{'buildtype'} : undef;
if ($kiwimode) {
@alldeps = PBuild::Util::unify(@$pdeps, @$vmdeps, @$sysdeps);
} else {
@alldeps = PBuild::Util::unify(@$pdeps, @$vmdeps, @$bdeps, @$sysdeps);
}
my @rpmlist;
my $binlocations = $ctx->{'repomgr'}->getbinarylocations($ctx->dep2bins_host(@alldeps));
for my $bin (@alldeps) {
push @rpmlist, "$bin $binlocations->{$bin}";
}
if (@{$tdeps || []}) {
$binlocations = $ctx->{'repomgr'}->getbinarylocations($ctx->dep2bins(@$tdeps));
for my $bin (@$tdeps) {
push @rpmlist, "sysroot: $bin $binlocations->{$bin}";
}
}
push @rpmlist, "preinstall: ".join(' ', @$pdeps);
push @rpmlist, "vminstall: ".join(' ', @$vmdeps);
push @rpmlist, "runscripts: ".join(' ', grep {$runscripts{$_}} (@$pdeps, @$vmdeps));
if (@$sysdeps && !$kiwimode) {
push @rpmlist, "noinstall: ".join(' ', grep {!($sysdeps{$_} || $vmdeps{$_} || $pdeps{$_})} @$bdeps);
push @rpmlist, "installonly: ".join(' ', grep {!$bdeps{$_}} @$sysdeps);
}
PBuild::Util::mkdir_p($buildroot);
PBuild::Util::writestr("$buildroot/.build.rpmlist", undef, join("\n", @rpmlist)."\n");
PBuild::Util::writestr("$buildroot/.build.config", undef, $ctx->{'buildconfig'});
my $needsbinariesforbuild;
my $needobspackage;
my $needsslcert;
my $needappxsslcert;
if ($p->{'buildtype'} ne 'kiwi') {
my $fd;
if (open($fd, '<', "$p->{'dir'}/$p->{'recipe'}")) {
while(<$fd>) {
chomp;
$needsbinariesforbuild = 1 if /^#\s*needsbinariesforbuild\s*$/s;
$needobspackage = 1 if /\@OBS_PACKAGE\@/;
$needsslcert = 1 if /^(?:#|Obs:)\s*needsslcertforbuild\s*$/s;
$needappxsslcert = 1 if /^(?:#|Obs:)\s*needsappxsslcertforbuild\s*$/s;
}
close($fd);
}
}
my $srcdir = $p->{'dir'};
my $copy_sources_asis;
# for kiwi/docker we need to copy the sources to $buildroot/.build-srcdir
# so that we can set up the "repos" and "containers" directories
if ($kiwimode || $p->{'asset_files'} || grep {/\/$/} keys %{$p->{'files'} || {}}) {
$srcdir = "$buildroot/.build-srcdir";
copy_sources($p, $srcdir);
$ctx->{'assetmgr'}->copy_assets($p, $srcdir) if $p->{'asset_files'};
export_origtar($p, $srcdir, $opts) if $p->{'recipe'} eq 'debian/control';
$copy_sources_asis = 1;
}
my $oldresultdir = "$ctx->{'builddir'}/$p->{'pkg'}";
my @args;
push @args, $helper if $helper;
push @args, "$opts->{'libbuild'}/build";
my $vm = $opts->{'vm-type'} || '';
if ($vm =~ /(xen|kvm|zvm|emulator|pvm|qemu)/) {
# allow setting the filesystem type with the build config
$opts->{'vm-disk-filesystem'} ||= $bconf->{'buildflags:vmfstype'} if $bconf->{'buildflags:vmfstype'};
$opts->{'vm-disk-filesystem-options'} ||= $bconf->{'buildflags:vmfsoptions'} if $bconf->{'buildflags:vmfsoptions'};
mkdir("$buildroot/.mount") unless -d "$buildroot/.mount";
push @args, "--root=$buildroot/.mount";
for my $opt (qw{vm-type vm-disk vm-swap vm-emulator-script vm-memory vm-kernel vm-initrd vm-custom-opt vm-disk-size vm-swap-size vm-disk-filesystem vm-disk-filesystem-options vm-disk-mount-options vm-disk-clean vm-hugetlbfs vm-worker vm-worker-no vm-enable-console vm-net vm-netdev vm-device vm-network}) {
next unless defined $opts->{$opt};
if ($opt eq 'vm-disk-clean' || $opt eq 'vm-enable-console') {
push @args, "--$opt",
} elsif (ref($opts->{$opt})) {
push @args, map {"--$opt=$_"} @{$opts->{$opt}};
} else {
push @args, "--$opt=$opts->{$opt}";
}
}
push @args, '--statistics';
push @args, '--vm-watchdog' unless $opts->{'shell'};
} elsif ($vm eq 'openstack') {
mkdir("$buildroot/.mount") unless -d "$buildroot/.mount";
push @args, "--root=$buildroot/.mount";
for my $opt (qw{vm-type vm-disk vm-swap vm-server vm-worker vm-kernel vm-openstack-flavor}) {
push @args, "--$opt=$opts->{$opt}" if defined $opts->{$opt},
}
} elsif ($vm eq 'lxc' || $vm eq 'docker') {
push @args, "--root=$buildroot";
for my $opt (qw{vm-type vm-memory}) {
push @args, "--$opt=$opts->{$opt}" if defined $opts->{$opt},
}
} else {
push @args, "--root=$buildroot";
push @args, "--vm-type=$vm" if $vm;
}
push @args, '--clean' unless $opts->{'noclean'};
push @args, '--nochecks' if $opts->{'nochecks'};
push @args, '--shell' if $opts->{'shell'};
push @args, '--shell-after-fail' if $opts->{'shell-after-fail'};
push @args, '--no-timestamps' if $opts->{'no-timestamps'};
push @args, '--skip-bundle';
push @args, '--changelog';
#push @args, '--oldpackages', $oldresultdir if -d $oldresultdir;
push @args, '--ccache' if $jobopts->{'ccache'};
push @args, '--ccache-create-archive' if $jobopts->{'ccache'};
push @args, '--ccache-type', $jobopts->{'ccache-type'} if $jobopts->{'ccache'} && $jobopts->{'ccache-type'};
if ($jobopts->{'ccache'} && -s "$oldresultdir/_ccache.tar") {
PBuild::Util::mkdir_p("$buildroot/.build.oldpackages");
PBuild::Util::cp("$oldresultdir/_ccache.tar", "$buildroot/.build.oldpackages/_ccache.tar");
push @args, "--ccache-archive", "$buildroot/.build.oldpackages/_ccache.tar";
}
push @args, '--dist', "$buildroot/.build.config";
push @args, '--rpmlist', "$buildroot/.build.rpmlist";
push @args, '--logfile', "$buildroot/.build.log";
#push @args, '--release', "$release" if defined $release;
push @args, '--debuginfo' if $ctx->{'debuginfo'} || $opts->{'debuginfo'};
push @args, "--arch=$arch";
push @args, '--jobs', $opts->{'jobs'} if $opts->{'jobs'};
push @args, '--threads', $opts->{'threads'} if $opts->{'threads'};
push @args, "--buildflavor=$p->{'flavor'}" if $p->{'flavor'};
push @args, "--obspackage=".($p->{'originpackage'} || $p->{'pkg'}) if $needobspackage;
push @args, "--copy-sources-asis" if $copy_sources_asis;
push @args, "--rpm-recipe-in-subdir" if $p->{'recipe'} =~ /^(?:package|dist)\/.*\.spec$/;
push @args, "$srcdir/$p->{'recipe'}";
if ($kiwimode) {
# now setup the repos/containers directories
$ctx->{'repomgr'}->copyimagebinaries($ctx->dep2bins(@$bdeps), $srcdir);
# tell kiwi how to use them
if ($p->{'buildtype'} eq 'kiwi') {
my @kiwiargs;
push @kiwiargs, '--ignore-repos';
push @kiwiargs, '--add-repo', 'dir://./repos/pbuild/pbuild';
push @kiwiargs, '--add-repotype', 'rpm-md';
push @kiwiargs, '--add-repoprio', '1';
if (-d "$srcdir/containers") {
for my $containerfile (grep {/\.tar$/} sort(PBuild::Util::ls("$srcdir/containers"))) {
push @kiwiargs, "--set-container-derived-from=dir://./containers/$containerfile";
}
}
push @args, map {"--kiwi-parameter=$_"} @kiwiargs;
}
}
unlink("$buildroot/.build.log");
#print "building $p->{'pkg'}/$p->{'recipe'}\n";
my $pid = forkjob($opts, \@args, "$buildroot/.build.log");
return { 'name' => $jobname, 'nbuilders' => $nbuilders, 'pid' => $pid, 'buildroot' => $buildroot, 'vm_type' => $vm, 'pdata' => $p, 'logfile' => "$buildroot/.build.log", 'logfile_lines' => 0, 'starttime' => time() };
}
#
# Move the build result into the correct place if we used a
# subdirectory for building
#
sub rename_build_result {
my ($vm, $buildroot) = @_;
return unless $vm =~ /(xen|kvm|zvm|emulator|pvm|qemu|openstack)/;
# get rid of old results
unlink("$buildroot/.build.packages");
if (-d "$buildroot/.build.packages") {
PBuild::Util::cleandir("$buildroot/.build.packages");
rmdir("$buildroot/.build.packages");
}
rename("$buildroot/.mount/.build.packages", "$buildroot/.build.packages") || die("final rename failed: $!\n");
# XXX: extracted cpio is flat but code below expects those directories...
symlink('.', "$buildroot/.build.packages/SRPMS");
symlink('.', "$buildroot/.build.packages/DEBS");
symlink('.', "$buildroot/.build.packages/KIWI");
}
#
# Return the last lines of a logfile
#
sub get_last_lines {
my ($logfile) = @_;
my $fd;
open($fd, '<', $logfile) || return '';
if (-s $fd > 8192) {
defined(sysseek($fd, -8192, 2)) || return '';
}
my $buf = '';
sysread($fd, $buf, 8192);
close $fd;
my @buf = split(/\r?\n/, $buf);
shift @buf if length($buf) == 8192 && @buf > 1;
@buf = splice(@buf, -5) if @buf > 5;
return @buf ? join("\n", @buf)."\n" : '';
}
#
# Finalize a build job after the build process has finished
#
sub finishjob {
my ($job) = @_;
die("job is still building\n") if $job->{'pid'};
my $buildroot = $job->{'buildroot'};
my $vm = $job->{'vm_type'};
my $p = $job->{'pdata'};
my $ret = $job->{'waitstatus'};
die("waitstatus not set\n") unless defined $ret;
$ret = 1 if $ret < 0;
# 1: build failure
# 2: unchanged build
# 3: badhost
# 4: fatal build error
# 9: genbuildreqs
if ($ret == 4) {
my $ll = get_last_lines("$buildroot/.build.log");
print $ll if $ll;
die("fatal build error, see $buildroot/.build.log for more information\n");
}
if ($ret == 3) {
$ret = 1;
}
if ($ret == 9) {
rename_build_result($vm, $buildroot);
die("XXX: dynamic buildreqs not implemented yet");
}
if (!$ret && (-l "$buildroot/.build.log" || ! -s _)) {
unlink("$buildroot/.build.log");
PBuild::Util::writestr("$buildroot/.build.log", undef, "build created no logfile!\n");
$ret = 1;
}
if ($ret) {
my $result = { '_log' => "$buildroot/.build.log" };
return ('failed', $result);
}
rename_build_result($vm, $buildroot);
my $result = collect_result($p, $buildroot);
$result->{'_log'} = "$buildroot/.build.log";
return ('succeeded', $result);
}
1;
0707010000000b000081a400000000000000000000000163e504b900000b61000000000000000000000000000000000000000f00000000PBuild/Link.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 PBuild::Link;
use strict;
use PBuild::Structured;
use PBuild::Util;
my $dtd_link = [
'link' =>
'project',
'package',
'baserev',
'missingok',
[ 'patches' => [[ '' => [] ]] ],
];
sub expand_single_link {
my ($pkgs, $pkg) = @_;
my @todo = ($pkg);
while (@todo) {
my $pkg = shift @todo;
my $p = $pkgs->{$pkg};
next if $p->{'error'} && $p->{'error'} =~ /^link expansion:/;
my $files = $p->{'files'} || {};
next unless $files->{'_link'};
my $link = PBuild::Structured::readxml("$p->{'dir'}/_link", $dtd_link, 1, 1);
if (!defined($link)) {
$p->{'error'} = 'link expansion: bad _link xml';
next;
}
if (exists $link->{'project'}) {
$p->{'error'} = 'link expansion: only local links allowed';
next;
}
if (!$link->{'package'}) {
$p->{'error'} = 'link expansion: no package attribute';
next;
}
if ((exists($link->{'patches'}) && exists($link->{'patches'}->{''})) || keys(%$files) != 1) {
$p->{'error'} = 'link expansion: only simple links supported';
next;
}
my $tpkg = $link->{'package'};
my $tp = $pkgs->{$tpkg};
if (!$tp) {
$p->{'error'} = "link expansion: target package '$tpkg' does not exist";
next;
}
if ($tp->{'error'} && $tp->{'error'} =~ /^link expansion:(.*)/) {
$p->{'error'} = "link expansion: $tpkg: $1";
$p->{'error'} = "link expansion: $1" if $1 eq 'cyclic link';
next;
}
if (($tp->{'files'} || {})->{'_link'}) {
if (grep {$_ eq $tpkg} @todo) {
$p->{'error'} = "link expansion: cyclic link";
} else {
unshift @todo, $tpkg, $pkg;
}
next;
}
$pkgs->{$pkg} = { %$tp, 'pkg' => $pkg };
}
}
sub expand_links {
my ($pkgs) = @_;
for my $pkg (sort keys %$pkgs) {
my $p = $pkgs->{$pkg};
my $files = $p->{'files'} || {};
expand_single_link($pkgs, $pkg) if $files->{'_link'};
}
}
sub count_links {
my ($pkgs) = @_;
return 0 + (grep {($_->{'files'} || {})->{'_link'}} values %$pkgs);
}
1;
0707010000000c000081a400000000000000000000000163e504b900001771000000000000000000000000000000000000001400000000PBuild/LocalRepo.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 PBuild::LocalRepo;
use strict;
use PBuild::Verify;
use PBuild::Util;
use PBuild::BuildResult;
use PBuild::ExportFilter;
my @binsufs = qw{rpm deb pkg.tar.gz pkg.tar.xz pkg.tar.zst};
my $binsufsre = join('|', map {"\Q$_\E"} @binsufs);
my $binsufsre_binlnk = join('|', map {"\Q$_\E"} (@binsufs, 'obsbinlnk'));
#
# Collect all build artifact information of the packages into a single
# global datastructure and store it in .pbuild/_bininfo
#
sub read_gbininfo {
my ($builddir, $pkgs) = @_;
my $old_gbininfo = PBuild::Util::retrieve("$builddir/.pbuild/_bininfo", 1);
my $gbininfo = {};
for my $pkg (@$pkgs) {
next unless -d "$builddir/$pkg";
if ($old_gbininfo->{$pkg} && $old_gbininfo->{$pkg}->{'id'}) {
my @s = stat("$builddir/$pkg/.bininfo");
if (@s && "$s[9]/$s[7]/$s[1]" eq $old_gbininfo->{$pkg}->{'id'}) {
$gbininfo->{$pkg} = $old_gbininfo->{$pkg};
next;
}
}
$gbininfo->{$pkg} = PBuild::BuildResult::read_bininfo("$builddir/$pkg", 1);
}
PBuild::Util::mkdir_p("$builddir/.pbuild");
PBuild::Util::store("$builddir/.pbuild/._bininfo.$$", "$builddir/.pbuild/_bininfo", $gbininfo);
return $gbininfo;
}
#
# Update the global build artifact data with the result of a new succeeded
# build
#
sub update_gbininfo {
my ($builddir, $pkg, $bininfo) = @_;
my $gbininfo = PBuild::Util::retrieve("$builddir/.pbuild/_bininfo");
if (defined($bininfo)) {
$gbininfo->{$pkg} = $bininfo;
} else {
delete $gbininfo->{$pkg};
}
PBuild::Util::store("$builddir/.pbuild/._bininfo.$$", "$builddir/.pbuild/_bininfo", $gbininfo);
}
sub orderpackids {
my ($pkgs) = @_;
return sort @$pkgs;
}
sub set_suf_and_filter_exports {
my ($arch, $bininfo, $filter) = @_;
my %n;
for my $rp (sort keys %$bininfo) {
my $r = $bininfo->{$rp};
delete $r->{'suf'};
next unless $r->{'source'}; # no src in full tree
next unless $r->{'name'}; # need binary name
my $suf;
$suf = $1 if $rp =~ /\.($binsufsre_binlnk)$/;
next unless $suf; # need a valid suffix
$r->{'suf'} = $suf;
my $nn = $rp;
$nn =~ s/.*\///;
if ($filter) {
my $skip;
for (@$filter) {
if ($nn =~ /$_->[0]/) {
$skip = $_->[1];
last;
}
}
if ($skip) {
my $myself;
for my $exportarch (@$skip) {
if ($exportarch eq '.' || $exportarch eq $arch) {
$myself = 1;
next;
}
}
next unless $myself;
}
}
$n{$nn} = $r;
}
return %n;
}
#
# Calculate the binaries that are to be used in subsequent builds from
# the global build artifact information
#
sub gbininfo2full {
my ($gbininfo, $arch, $useforbuild, $filter) = @_;
my @packids = orderpackids([ keys %$gbininfo ]);
# construct new full
my %full;
for my $packid (@packids) {
next unless $useforbuild->{$packid};
my $bininfo = $gbininfo->{$packid};
next if $bininfo->{'.nouseforbuild'}; # channels/patchinfos don't go into the full tree
my %f = set_suf_and_filter_exports($arch, $bininfo, $filter);
for my $fn (sort { ($f{$a}->{'imported'} || 0) <=> ($f{$b}->{'imported'} || 0) || $a cmp $b} keys %f) {
my $r = $f{$fn};
$r->{'packid'} = $packid;
$r->{'filename'} = $fn;
$r->{'location'} = "$packid/$fn";
my $or = $full{$r->{'name'}};
$full{$r->{'name'}} = $r if $or && $or->{'packid'} eq $packid && volatile_cmp($r, $or);
$full{$r->{'name'}} ||= $r; # first one wins
}
}
return %full;
}
#
# get metadata of build artifacts that are to be used in subsequent builds
#
sub fetchrepo {
my ($bconf, $arch, $builddir, $pkgsrc, $pkgs) = @_;
my @pkgs = sort @{$pkgs || [ sort keys %$pkgsrc ] };
my $gbininfo = read_gbininfo($builddir, \@pkgs);
my $filter = PBuild::ExportFilter::calculate_exportfilter($bconf, $arch);
my %useforbuild = map {$_ => $pkgsrc->{$_}->{'useforbuildenabled'}} @pkgs;
for (@pkgs) {
my $p = $pkgsrc->{$_};
delete $useforbuild{$_} if ($p->{'error'} || '') eq 'excluded';
}
my %full = gbininfo2full($gbininfo, $arch, \%useforbuild, $filter);
my $bins = [ sort { $a->{'name'} cmp $b->{'name'} } values %full ];
my $repofile = "$builddir/.pbuild/_metadata";
PBuild::Util::store("$builddir/.pbuild/._metadata.$$", $repofile, $bins);
return $bins;
}
#
# Delete no obsolete entries in the builddir
#
sub cleanup_builddir {
my ($builddir, $pkgsrc) = @_;
my @pkgs = sort keys %$pkgsrc;
my @d = PBuild::Util::ls($builddir);
my %obsolete;
for my $d (@d) {
next if $d eq '.pbuild' || $d =~ /^_/;
my $p = $pkgsrc->{$d};
$obsolete{$d} = 1 if !$p || ($p->{'error'} || '') eq 'excluded';
}
return unless %obsolete;
my $gbininfo = PBuild::Util::retrieve("$builddir/.pbuild/_bininfo", 1);
if ($gbininfo) {
delete $gbininfo->{$_} for keys %obsolete;
PBuild::Util::store("$builddir/.pbuild/._bininfo.$$", "$builddir/.pbuild/_bininfo", $gbininfo);
}
for my $d (sort keys %obsolete) {
next unless -d "$builddir/$d";
PBuild::Util::cleandir("$builddir/$d");
rmdir("$builddir/$d");
}
}
1;
0707010000000d000081a400000000000000000000000163e504b900001177000000000000000000000000000000000000000f00000000PBuild/Meta.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 PBuild::Meta;
use strict;
my $genmetaalgo = 0;
sub add_meta {
my ($new_meta, $m, $bin, $packid) = @_;
my $oldlen = @$new_meta;
for (split("\n", ref($m) ? $m->[0] : $m)) {
s/ / $bin\//;
push @$new_meta, $_;
}
if (@$new_meta != $oldlen) {
if (defined($packid) && $new_meta->[$oldlen] =~ /\/\Q$packid\E$/) {
# do not include our own build results
splice(@$new_meta, $oldlen);
} else {
# fixup first line, it contains the package name and not the binary name
$new_meta->[$oldlen] =~ s/ .*/ $bin/;
}
}
}
sub gen_meta {
my ($subp, @deps) = @_;
my @subp = @{$subp || []};
#print "gen_meta @subp\n";
my $subpackre = '';
for (@subp) {
$subpackre .= "|/\Q$_\E/";
}
if ($subpackre) {
$subpackre = substr($subpackre, 1);
$subpackre = qr/$subpackre/;
}
# setup helpers
my (%helper1, %helper2, %helper3, %cycle);
for (@deps) {
$helper1{$_} = tr/\///; # count '/'
/^([^ ]+ )((?:.*\/)?([^\/]*))$/ or die("bad dependency line: $_\n");
$helper2{$_} = $2; # path
$helper3{$_} = "$1$3"; # md5 lastpkg
if ($subpackre && "/$2/" =~ /$subpackre/) {
/ ([^\/]+)/ or die("bad dependency line: $_\n");
$cycle{$1} = 1; # detected a cycle!
}
}
# sort
@deps = sort {$helper1{$a} <=> $helper1{$b} || $helper2{$a} cmp $helper2{$b} || $a cmp $b} @deps;
undef $subpackre unless %cycle; # speed things up a bit
# ignore self-cycles
if (%cycle) {
delete $cycle{$_} for @subp;
# print "CYC: ".join(' ', keys %cycle)."\n";
}
# handle cycles
my %cycdepseen;
if (%cycle) {
my $cyclere = '';
$cyclere .= "|\Q/$_/\E" for sort keys %cycle;
$cyclere = substr($cyclere, 1);
$cyclere = qr/$cyclere/;
if (!$genmetaalgo) {
# kill all deps that use a package that we see directly
@deps = grep {"$_/" !~ /$cyclere/} @deps;
} else {
for my $d (grep {"$_/" =~ /$cyclere/} @deps) {
$cycdepseen{$helper3{$d}} ||= $helper1{$d};
}
}
}
# prune
my %depseen;
my @meta;
for my $d (@deps) {
next if $depseen{$helper3{$d}}; # skip if we already have this pkg with this md5
next if $subpackre && "/$helper2{$d}/" =~ /$subpackre/;
$depseen{$helper3{$d}} = 1;
push @meta, $d;
}
# do extra cycle pruning
if (%cycdepseen) {
@meta = grep {!$cycdepseen{$helper3{$_}} || $helper1{$_} < $cycdepseen{$helper3{$_}}} @meta;
}
return @meta;
}
sub setgenmetaalgo {
my ($algo) = @_;
$algo = 1 if $algo < 0;
die("BSBuild::setgenmetaalgo: unsupported algo $algo\n") if $algo > 1;
$genmetaalgo = $algo;
return $algo;
}
sub sortedmd5toreason {
my @res;
for my $line (@_) {
my $tag = substr($line, 0, 1); # just the first char
$tag = 'md5sum' if $tag eq '!';
$tag = 'added' if $tag eq '+';
$tag = 'removed' if $tag eq '-';
push @res, { 'change' => $tag, 'key' => substr($line, 1) };
}
return \@res;
}
sub diffsortedmd5 {
my ($fromp, $top) = @_;
my @ret;
my @from = map {[$_, substr($_, 34)]} @$fromp;
my @to = map {[$_, substr($_, 34)]} @$top;
@from = sort {$a->[1] cmp $b->[1] || $a->[0] cmp $b->[0]} @from;
@to = sort {$a->[1] cmp $b->[1] || $a->[0] cmp $b->[0]} @to;
for my $f (@from) {
if (@to && $f->[1] eq $to[0]->[1]) {
push @ret, "!$f->[1]" if $f->[0] ne $to[0]->[0];
shift @to;
next;
}
if (!@to || $f->[1] lt $to[0]->[1]) {
push @ret, "-$f->[1]";
next;
}
while (@to && $f->[1] gt $to[0]->[1]) {
push @ret, "+$to[0]->[1]";
shift @to;
}
redo;
}
push @ret, "+$_->[1]" for @to;
return @ret;
}
1;
0707010000000e000081a400000000000000000000000163e504b900000f4c000000000000000000000000000000000000001200000000PBuild/Modules.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 PBuild::Modules;
use strict;
use PBuild::Util;
#
# reduce the binaries to the ones selected by the given module list
#
sub prune_to_modules {
my ($modules, $data, $bins) = @_;
my %modules = map {$_ => 1} @{$modules || []};
# expand modules to streams if we have the data
my $moduleinfo = $data->{'/moduleinfo'};
if ($moduleinfo) {
my %pmodules = %modules;
for (keys %pmodules) {
$pmodules{$_} = 1 if /^(.*)-/; # also provide without the stream suffix
}
my %xmodules;
for my $mi (@$moduleinfo) {
next unless $modules{$mi->{'name'}};
my @req = grep {$_ ne 'platform' && !/^platform-/} @{$mi->{'requires'} || []};
next if grep {!$pmodules{$_}} @req;
$xmodules{"$mi->{'name'}\@$mi->{'context'}"} = 1;
}
%modules = %xmodules;
}
# now get rid of all packages not in a module
my @nbins;
my @notmod;
my %inmod;
for my $bin (@$bins) {
my $evr = $bin->{'epoch'} ? "$bin->{'epoch'}:$bin->{'version'}" : $bin->{'version'};
$evr .= "-$bin->{'release'}" if defined $bin->{'release'};
my $nevra = "$bin->{'name'}-$evr.$bin->{'arch'}";
if ($data->{$nevra}) {
next unless grep {$modules{$_}} @{$data->{$nevra}};
$inmod{$bin->{'name'}} = 1;
} else {
# not in a module
next if $bin->{'release'} && $bin->{'release'} =~ /\.module_/; # hey!
push @notmod, $bin;
}
push @nbins, $bin;
}
for (@notmod) {
$_ = undef if $inmod{$_->{'name'}};
}
@nbins = grep {defined($_)} @nbins;
return \@nbins;
}
#
# return the modules a package belongs to
#
sub getmodules {
my ($data, $bin) = @_;
my $moduleinfo = $data->{'/moduleinfo'};
my $evr = $bin->{'epoch'} ? "$bin->{'epoch'}:$bin->{'version'}" : $bin->{'version'};
$evr .= "-$bin->{'release'}" if defined $bin->{'release'};
my $nevra = "$bin->{'name'}-$evr.$bin->{'arch'}";
return @{$data->{$nevra} || []};
}
#
# return which modules are missing from the module config
#
sub missingmodules {
my ($modules, $data) = @_;
my $moduleinfo = $data->{'/moduleinfo'};
return () unless $moduleinfo && @{$modules || []};
my %modules = map {$_ => 1} @$modules;
my %pmodules = %modules;
for (keys %pmodules) {
$pmodules{$_} = 1 if /^(.*)-/; # also provide without the stream suffix
}
my %missingmods;
for my $mi (@$moduleinfo) {
my $n = $mi->{'name'};
next unless $modules{$n};
next if exists($missingmods{$n}) && !$missingmods{$n};
my @req = grep {$_ ne 'platform' && !/^platform-/} @{$mi->{'requires'} || []};
my $bad;
for (grep {!$pmodules{$_}} @req) {
push @{$missingmods{$n}}, $_;
$bad = 1;
}
$missingmods{$n} = undef unless $bad;
}
delete $missingmods{$_} for grep {!$missingmods{$_}} keys %missingmods;
return undef unless %missingmods;
my $msg = '';
for my $mod (sort keys %missingmods) {
my @m = sort(PBuild::Util::unify(@{$missingmods{$mod}}));
if (@m > 1) {
$msg .= ", $mod needs one of ".join(',', @m);
} else {
$msg .= ", $mod needs $m[0]";
}
}
return substr($msg, 2);
}
1;
0707010000000f000081a400000000000000000000000163e504b9000009c5000000000000000000000000000000000000001500000000PBuild/Multibuild.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 PBuild::Multibuild;
use strict;
use PBuild::Structured;
use PBuild::Verify;
my $dtd_multibuild = [
'multibuild' =>
[ 'package' ], # obsolete
[ 'flavor' ],
];
sub find_mbname {
my ($files) = @_;
my $mbname = '_multibuild';
# support service generated multibuild files, see findfile
if ($files->{'_service'}) {
for (sort keys %$files) {
next unless /^_service:.*:(.*?)$/s;
$mbname = $_ if $1 eq '_multibuild';
}
}
return $mbname;
}
sub readmbxml {
my ($xmlfile) = @_;
my $mb = PBuild::Structured::readxml($xmlfile, $dtd_multibuild);
PBuild::Verify::verify_multibuild($mb);
return $mb;
}
sub getmultibuild_fromfiles {
my ($srcdir, $files) = @_;
my $mbname = find_mbname($files);
my $mb;
if ($files->{$mbname}) {
eval { $mb = readmbxml("$srcdir/$mbname") };
if ($@) {
warn("$srcdir/$mbname: $@");
return undef;
}
$mb->{'_md5'} = $files->{$mbname} if $mb;
}
return $mb;
}
sub expand_multibuilds {
my ($pkgs) = @_;
for my $pkg (sort keys %$pkgs) {
my $p = $pkgs->{$pkg};
my $mb = getmultibuild_fromfiles($p->{'dir'}, $p->{'files'});
next unless $mb;
my @mbp = @{$mb->{'flavor'} || $mb->{'package'} || []};
for my $flavor (@mbp) {
my $mpkg = "$pkg:$flavor";
$pkgs->{$mpkg} = { %$p, 'pkg' => $mpkg, 'flavor' => $flavor, 'originpackage' => $pkg };
}
}
}
sub count_multibuilds {
my ($pkgs) = @_;
my $c = 0;
for (values %$pkgs) {
my $files = $_->{'files'} || {};
next unless $files->{'_multibuild'} || ($files->{'_service'} && $files->{find_mbname($files)});
$c++;
}
return $c;
}
1;
07070100000010000081a400000000000000000000000163e504b9000024b2000000000000000000000000000000000000000e00000000PBuild/OBS.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 PBuild::OBS;
use strict;
use Build::Download;
use PBuild::Util;
use PBuild::Cpio;
use PBuild::Structured;
my @binsufs = qw{rpm deb pkg.tar.gz pkg.tar.xz pkg.tar.zst};
my $binsufsre = join('|', map {"\Q$_\E"} @binsufs);
my @dtd_disableenable = (
[[ 'disable' =>
'arch',
'repository',
]],
[[ 'enable' =>
'arch',
'repository',
]],
);
my $dtd_repo = [
'repository' =>
'name',
'rebuild',
'block',
'linkedbuild',
[[ 'path' =>
'project',
'repository',
]],
[ 'arch' ],
];
my $dtd_proj = [
'project' =>
'name',
'kind',
[],
[[ 'link' =>
'project',
'vrevmode',
]],
[ 'lock' => @dtd_disableenable ],
[ 'build' => @dtd_disableenable ],
[ 'publish' => @dtd_disableenable ],
[ 'debuginfo' => @dtd_disableenable ],
[ 'useforbuild' => @dtd_disableenable ],
[ 'binarydownload' => @dtd_disableenable ],
[ 'sourceaccess' => @dtd_disableenable ],
[ 'access' => @dtd_disableenable ],
[ $dtd_repo ],
];
#
# get the project data from an OBS project
#
sub fetch_proj {
my ($projid, $baseurl) = @_;
my $projid2 = PBuild::Util::urlencode($projid);
my ($projxml) = Build::Download::fetch("${baseurl}source/$projid2/_meta");
return PBuild::Structured::fromxml($projxml, $dtd_proj, 0, 1);
}
#
# get the config from an OBS project
#
sub fetch_config {
my ($prp, $baseurl) = @_;
my ($projid, $repoid) = split('/', $prp, 2);
my $projid2 = PBuild::Util::urlencode($projid);
my ($config) = Build::Download::fetch("${baseurl}source/$projid2/_config", 'missingok' => 1);
$config = '' unless defined $config;
$config = "\n### from $projid\n%define _repository $repoid\n$config" if $config;
return $config;
}
#
# expand the path for an OBS project/repository
#
sub expand_path {
my ($prp, $baseurl) = @_;
my %done;
my @ret;
my @path = ($prp);
while (@path) {
my $t = shift @path;
push @ret, $t unless $done{$t};
$done{$prp} = 1;
if (!@path) {
last if $done{"/$t"};
my ($tprojid, $trepoid) = split('/', $t, 2);
my $proj = fetch_proj($tprojid, $baseurl);
$done{"/$t"} = 1;
my $repo = (grep {$_->{'name'} eq $trepoid} @{$proj->{'repository'} || []})[0];
next unless $repo;
for (@{$repo->{'path'} || []}) {
push @path, "$_->{'project'}/$_->{'repository'}";
}
}
}
return @ret;
}
#
# get the configs/repo urls for an OBS project/repository
# expand the path if $islast is true
#
sub fetch_all_configs {
my ($url, $opts, $islast) = @_;
die("bad obs: reference\n") unless $url =~ /^obs:\/{1,3}([^\/]+\/[^\/]+)\/?$/;
my $prp = PBuild::Util::urldecode($1);
die("please specify the build service url with the --obs option\n") unless $opts->{'obs'};
my $baseurl = $opts->{'obs'};
$baseurl .= '/' unless $baseurl =~ /\/$/;
my @prps;
if ($islast) {
@prps = expand_path($prp, $baseurl);
} else {
@prps = ($prp);
}
my @configs;
for my $xprp (@prps) {
my $config = fetch_config($xprp, $baseurl);
push @configs, $config if $config;
}
my @repourls;
push @repourls, "obs:\/".PBuild::Util::urlencode($_) for @prps;
return (\@configs, \@repourls);
}
#
# parse a dependency in libsolv's testcase style
#
my %testcaseops = (
'&' => 1,
'|' => 2,
'<IF>' => 3,
'<UNLESS' => 4,
'<ELSE>' => 5,
'+' => 6,
'-' => 7,
);
sub parse_testcasedep_rec {
my ($dep, $chainop) = @_;
no warnings 'recursion';
my $d = $dep;
$chainop ||= 0;
my ($r, $r2);
$d =~ s/^\s+//;
if ($d =~ s/^\(//) {
($d, $r) = parse_testcasedep_rec($d);
return ($d, undef) unless $r && $d =~ s/\s*^\)//;
} else {
return ($d, undef) if $d eq '' || $d =~ /^\)/;
return ($d, undef) unless $d =~ s/([^\s\)]+)//;
$r = $1;
$r .= ')' if $d =~ /^\)/ && $r =~ /\([^\)]+$/ && $d =~ s/^\)//;
$r = "$r$1" if $d =~ s/^( (?:<|<=|>|>=|<=>|=) [^\s\)]+)//;
$r =~ s/\\([A-Fa-f2-9][A-Fa-f0-9])/chr(hex($1))/sge;
$r = [0, $r];
}
$d =~ s/^\s+//;
return ($d, $r) if $d eq '' || $d =~ /^\)/;
return ($d, undef) unless $d =~ s/([^\s\)]+)//;
my $op = $testcaseops{$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_testcasedep_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);
}
#
# convert a parsed dependency to rpm's rich dep style
#
my @rpmops = ('', 'and', 'or', 'if', 'unless', 'else', 'with', 'without');
sub rpmdepformat_rec {
my ($r, $addparens) = @_;
no warnings 'recursion';
my $op = $r->[0];
return $r->[1] unless $op;
my $top = $rpmops[$op];
my $r1 = rpmdepformat_rec($r->[1], 1);
if (($op == 3 || $op == 4) && @$r == 4) {
$r1 = "$r1 $top " . rpmdepformat_rec($r->[2], 1);
$top = 'else';
}
my $addparens2 = 1;
$addparens2 = 0 if $r->[2]->[0] == $op && ($op == 1 || $op == 2 || $op == 6);
my $r2 = rpmdepformat_rec($r->[-1], $addparens2);
return $addparens ? "($r1 $top $r2)" : "$r1 $top $r2";
}
#
# recode the dependencies in a binary from testcaseformat to native
#
sub recode_deps {
my ($b) = @_;
for my $dep (@{$b->{'requires'} || []}, @{$b->{'conflicts'} || []}, @{$b->{'recommends'} || []}, @{$b->{'supplements'} || []}) {
next unless $dep =~ / (?:<[A-Z]|[\-\+\|\&\.])/;
my ($d, $r) = parse_testcasedep_rec($dep);
next if !$r || $d ne '';
$dep = rpmdepformat_rec($r, 1); # currently only rpm supported
}
}
#
# Extract a binary from the cpio archive downloaded by fetchbinaries
#
sub fetch_binaries_cpioextract {
my ($ent, $xfile, $repodir, $names, $callback) = @_;
return undef unless $ent->{'cpiotype'} == 8;
my $name = $ent->{'name'};
if (!defined($xfile)) {
return undef unless $name =~ s/\.($binsufsre)$//;
my $suf = $1;
return undef unless $names->{$name};
my $tmpname = $names->{$name}->[0];
return undef unless $tmpname =~ /\.\Q$suf\E$/;
return "$repodir/$tmpname"; # ok, extract this one!
}
die unless $name =~ s/\.($binsufsre)$//;
die unless $names->{$name};
$callback->($repodir, @{$names->{$name}});
return undef; # continue extracting
}
#
# Download binaries in batches from a remote obs instance
#
sub fetch_binaries {
my ($url, $repodir, $names, $callback, $ua) = @_;
my @names = sort keys %$names;
while (@names) {
$ua ||= Build::Download::create_ua();
my @nchunk = splice(@names, 0, 100);
my $chunkurl = "$url/_repository?view=cpio";
$chunkurl .= "&binary=".PBuild::Util::urlencode($_) for @nchunk;
my $tmpcpio = "$repodir/.$$.binaries.cpio";
Build::Download::download($chunkurl, $tmpcpio, undef, 'ua' => $ua, 'retry' => 3);
PBuild::Cpio::cpio_extract($tmpcpio, sub {fetch_binaries_cpioextract($_[0], $_[1], $repodir, $names, $callback)});
unlink($tmpcpio);
}
}
#
# Get the repository metadata for an OBS repo
#
sub fetch_repodata {
my ($url, $tmpdir, $arch, $opts, $modules) = @_;
die("bad obs: reference\n") unless $url =~ /^obs:\/{1,3}([^\/]+\/[^\/]+)(?:\/([^\/]*))?$/;
my $prp = $1;
$arch = $2 if $2;
die("please specify the build service url with the --obs option\n") unless $opts->{'obs'};
my $baseurl = $opts->{'obs'};
$baseurl .= '/' unless $baseurl =~ /\/$/;
my $requrl .= "${baseurl}build/$prp/$arch/_repository?view=cache";
$requrl .= "&module=".PBuild::Util::urlencode($_) for @{$modules || []};
Build::Download::download($requrl, "$tmpdir/repository.cpio", undef, 'retry' => 3);
unlink("$tmpdir/repository.data");
PBuild::Cpio::cpio_extract("$tmpdir/repository.cpio", "$tmpdir/repository.data", 'extract' => 'repositorycache', 'missingok' => 1);
my $rdata;
$rdata = PBuild::Util::retrieve("$tmpdir/repository.data") if -s "$tmpdir/repository.data";
my @bins = grep {ref($_) eq 'HASH' && defined($_->{'name'})} values %{$rdata || {}};
for (@bins) {
if ($_->{'path'} =~ /^\.\.\/([^\/\.][^\/]*\/[^\/\.][^\/]*)$/s) {
$_->{'location'} = "${baseurl}build/$prp/$arch/$1"; # obsbinlink to package
} else {
$_->{'location'} = "${baseurl}build/$prp/$arch/_repository/$_->{'path'}";
}
recode_deps($_); # recode deps from testcase format to rpm
}
return \@bins;
}
1;
07070100000011000081a400000000000000000000000163e504b9000017a3000000000000000000000000000000000000001200000000PBuild/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 PBuild::Options;
use Build::Options;
use strict;
my $pbuild_options = {
'h' => 'help',
'help' => '',
'preset' => ':',
'list-presets' => '',
'listpresets' => 'list-presets',
'reponame' => ':',
'noclean' => '',
'no-clean' => 'noclean',
'nochecks' => '',
'no-checks' => 'nochecks',
'arch' => ':',
'hostarch' => ':',
'host-arch' => 'hostarch:',
'target' => ':',
'jobs' => ':',
'threads' => ':',
'buildjobs' => ':',
'root' => ':',
'dist' => '::',
'configdir' => ':',
'repo' => '::',
'repository' => 'repo::',
'registry' => '::',
'assets' => '::',
'obs' => ':',
'hostrepo' => '::',
'hostrepository' => 'hostrepo::',
'result' => \&result_rebuild_special,
'result-pkg' => '::',
'result-code' => '::',
'details' => '',
'terse' => '',
'rebuild' => \&result_rebuild_special,
'rebuild-pkg' => '::',
'rebuild-code' => '::',
'buildtrigger' => ':',
'repoquery' => '::',
'repoquery-host' => '::',
'no-repo-refresh' => '',
'xen' => \&vm_type_special,
'kvm' => \&vm_type_special,
'uml' => \&vm_type_special,
'qemu' => \&vm_type_special,
'emulator' => \&vm_type_special,
'zvm' => \&vm_type_special,
'lxc' => \&vm_type_special,
'vm-type' => ':',
'vm-worker' => ':',
'vm-worker-no' => ':',
'vm-worker-nr' => 'vm-worker-no:',
'vm-server' => ':',
'vm-region' => 'vm-server:',
'vm-disk' => ':',
'vm-swap' => ':',
'swap' => 'vm-swap:',
'vm-memory' => ':',
'memory' => 'vm-memory:',
'vm-kernel' => ':',
'vm-initrd' => ':',
'vm-disk-size' => ':',
'vmdisk-rootsize' => 'vm-disk-size:',
'vm-swap-size' => ':',
'vmdisk-swapsize' => 'vm-swap-size:',
'vm-disk-filesystem' => ':',
'vmdisk-filesystem' => 'vm-disk-filesystem:',
'vm-disk-filesystem-options' => ':',
'vmdisk-filesystem-options' => 'vm-disk-filesystem-options:',
'vm-disk-mount-options' => ':',
'vmdisk-mount-options' => 'vm-disk-mount-options:',
'vm-disk-clean' => '',
'vmdisk-clean' => 'vm-disk-clean',
'vm-hugetlbfs' => ':',
'hugetlbfs' => 'vm-hugetlbfs:',
'vm-watchdog' => '',
'vm-user' => ':',
'vm-enable-console' => '',
'vm-telnet' => ':',
'vm-net' => '::',
'vm-network' => '',
'vm-netdev' => '::',
'vm-device' => '::',
'vm-custom-opt' => ':',
'vm-openstack-flavor' => ':',
'openstack-flavor' => 'vm-openstack-flavor:',
'vm-emulator-script' => ':',
'debuginfo' => '',
'debug' => 'debuginfo',
'emulator-script' => 'vm-emulator-script:',
'single' => ':',
'single-flavor' => ':',
'shell' => '',
'shell-after-fail' => '',
'no-timestamps' => '',
'showlog' => '',
'ccache' => \&ccache_special,
'ccache-type' => '',
};
sub vm_type_special {
my ($opts, $opt, $origopt, $args) = @_;
my $arg;
$arg = Build::Options::getarg($origopt, $args, 1) unless $opt eq 'zvm' || $opt eq 'lxc';
$opts->{'vm-disk'} = $arg if defined $arg;
$opts->{'vm-type'} = $opt;
}
sub ccache_special {
my ($opts, $opt, $origopt, $args) = @_;
my $arg;
$arg = Build::Options::getarg($origopt, $args) if @$args && ref($args->[0]);
$opts->{'ccache'} = 1;
$opts->{'ccache-type'} = $arg if $arg;
}
my @codes = qw{broken succeeded failed unresolvable blocked scheduled waiting building excluded disabled locked};
my %known_codes = map {$_ => 1} @codes;
sub result_rebuild_special {
my ($opts, $opt, $origopt, $args) = @_;
my $arg;
$arg = Build::Options::getarg($origopt, $args, 1) if @$args && (ref($args->[0]) || $args->[0] !~ /\//);
if (!defined($arg) || $arg eq 'all') {
push @{$opts->{"$opt-code"}}, 'all';
} elsif ($known_codes{$arg}) {
push @{$opts->{"$opt-code"}}, $arg;
} else {
push @{$opts->{"$opt-pkg"}}, $arg;
}
}
sub parse_options {
return Build::Options::parse_options($pbuild_options, @_);
}
sub usage {
my ($exitstatus) = @_;
print <<'EOS';
Usage: pbuild [options] [dir]
Build all packages in the directory 'dir'.
Important options (see the man page for a full list):
--dist known_dist|url|file
distribution to build for
--repo url
repository to use, can be given multiple times
--registry url
registry to use, can be given multiple times
--preset name
specify a preset defined in the project
--list-presets
list all known presets
--reponame name
name of the destination dir
defaults to "_build.<dist>.<arch>"
--buildjobs number
build in parallel with 'number' jobs
--root rootdir
do the build in the 'rootdir' directory
defaults to '/var/tmp/build-root'
--arch arch
build for architecture 'arch'
defaults to the host architecture
--obs url
open build service instance for obs:/ type urls
--vm-*, --xen, --kvm, ...
passed to the build tool, see the build(1) manpage
--result
show the package build status
EOS
exit($exitstatus) if defined $exitstatus;
}
sub merge_old_options {
my ($opts, $oldopts) = @_;
my $newopts = {};
for (qw{preset dist repo hostrepo registry assets obs configdir root jobs threads buildjobs}) {
$opts->{$_} = $oldopts->{$_} if !exists($opts->{$_}) && exists($oldopts->{$_});
$newopts->{$_} = $opts->{$_} if exists($opts->{$_});
}
return $newopts;
}
1;
07070100000012000081a400000000000000000000000163e504b900000c71000000000000000000000000000000000000001100000000PBuild/Preset.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 PBuild::Preset;
use PBuild::Structured;
use PBuild::Util;
use strict;
my $dtd_pbuild = [
'pbuild' =>
[[ 'preset' =>
'name',
'default',
'arch',
[ 'config' ],
[ 'repo' ],
[ 'registry' ],
[ 'assets' ],
'obs',
[ 'hostrepo' ],
]],
];
# read presets, take default if non given.
sub read_presets {
my ($dir, $presetname) = @_;
if (-f "$dir/_pbuild") {
my $pbuild = PBuild::Structured::readxml("$dir/_pbuild", $dtd_pbuild);
for my $preset (@{$pbuild->{'preset'} || []}) {
next unless $preset->{'name'};
if (defined($presetname)) {
# check for selected preset
return $preset if $presetname eq $preset->{'name'};
} else {
# check for default
return $preset if exists $preset->{'default'};
}
}
}
die("unknown preset '$presetname'\n") if defined $presetname;
return undef;
}
# get a list of defined presets
sub known_presets {
my ($dir) = @_;
my @presetnames;
if (-f "$dir/_pbuild") {
my $pbuild = PBuild::Structured::readxml("$dir/_pbuild", $dtd_pbuild);
for my $d (@{$pbuild->{'preset'} || []}) {
push @presetnames, $d->{'name'} if defined $d->{'name'};
}
@presetnames = PBuild::Util::unify(@presetnames);
}
return @presetnames;
}
# show presets
sub list_presets {
my ($dir) = @_;
my @presetnames = known_presets($dir);
if (@presetnames) {
print "Known presets:\n";
print " - $_\n" for @presetnames;
} else {
print "No presets defined\n";
}
}
# get reponame/dist/repo/registry options from preset
sub apply_preset {
my ($opts, $preset) = @_;
$opts->{'arch'} = $preset->{'arch'} if $preset->{'arch'} && !$opts->{'arch'};
$opts->{'reponame'} = $preset->{'name'} if $preset->{'name'} && !$opts->{'reponame'};
push @{$opts->{'dist'}}, @{$preset->{'config'}} if $preset->{'config'} && !$opts->{'dist'};
push @{$opts->{'repo'}}, @{$preset->{'repo'}} if $preset->{'repo'} && !$opts->{'repo'};
push @{$opts->{'registry'}}, @{$preset->{'registry'}} if $preset->{'registry'} && !$opts->{'registry'};
push @{$opts->{'assets'}}, @{$preset->{'assets'}} if $preset->{'assets'} && !$opts->{'assets'};
$opts->{'obs'} = $preset->{'obs'} if $preset->{'obs'} && !$opts->{'obs'};
push @{$opts->{'hostrepo'}}, @{$preset->{'hostrepo'}} if $preset->{'hostrepo'} && !$opts->{'hostrepo'};
}
1;
07070100000013000081a400000000000000000000000163e504b900001dfa000000000000000000000000000000000000001100000000PBuild/Recipe.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 PBuild::Recipe;
use strict;
use Build;
use PBuild::Service;
use PBuild::Util;
$Build::Kiwi::urlmapper = 0; # disable url -> prp mapping
#
# Select a recipe file from the source files
#
sub find_recipe {
my ($p, $type) = @_;
my %files = map {$_ => $_} keys %{$p->{'files'} || {}};
return $files{'_preinstallimage'} if $type ne 'kiwi' && keys(%files) == 1 && $files{'_preinstallimage'};
return $files{'simpleimage'} if $files{'simpleimage'};
return $files{'snapcraft.yaml'} if $type eq 'snapcraft' && $files{'snapcraft.yaml'};
return $files{'appimage.yml'} if $type eq 'appimage' && $files{'appimage.yml'};
return $files{'Dockerfile'} if $type eq 'docker' && $files{'Dockerfile'};
return $files{'fissile.yml'} if $type eq 'fissile' && $files{'fissile.yml'};
return $files{'Chart.yaml'} if $type eq 'helm' && $files{'Chart.yaml'};
return (grep {/flatpak\.(?:ya?ml|json)$/} sort keys %files)[0] if $type eq 'flatpak';
return $files{'PKGBUILD'} ? $files{'PKGBUILD'} : undef if $type eq 'arch';
my $pkg = $p->{'pkg'};
$pkg = $p->{'flavor'} if $p->{'flavor'};
return $files{"$pkg.$type"} if $files{"$pkg.$type"};
# try again without last components
return $files{"$1.$type"} if $pkg =~ /^(.*?)\./ && $files{"$1.$type"};
my @files = grep {/\.$type$/} keys %files;
@files = grep {/^\Q$pkg\E/i} @files if @files > 1;
return $files{$files[0]} if @files == 1;
if (@files > 1) {
@files = sort @files;
return $files{$files[0]};
}
return $files{'debian.control'} if $type eq 'dsc' && $files{'debian.control'};
return $files{'debian/control'} if $type eq 'dsc' && $files{'debian/control'};
# as last resort ignore the type for image/container building
if ($type ne 'docker') {
return $files{'Dockerfile'} if $files{'Dockerfile'};
}
if ($type ne 'kiwi') {
@files = grep {/\.kiwi$/} keys %files;
@files = grep {/^\Q$pkg\E/i} @files if @files > 1;
return $files{$files[0]} if @files == 1;
if (@files > 1) {
@files = sort @files;
return $files{$files[0]};
}
}
if (1) {
@files = grep {/mkosi\.$/} keys %files;
return $files{$files[0]} if @files == 1;
if (@files > 1) {
@files = sort @files;
return $files{$files[0]};
}
}
if ($type eq 'spec' && $files{'package/'}) {
my @specs = sort(grep {/\.spec/} PBuild::Util::ls("$p->{'dir'}/package"));
return "package/$specs[0]" if @specs;
}
if ($type eq 'spec' && $files{'dist/'}) {
my @specs = sort(grep {/\.spec/} PBuild::Util::ls("$p->{'dir'}/dist"));
return "dist/$specs[0]" if @specs;
}
return undef;
}
#
# Find and parse a recipe file
#
sub parse {
my ($bconf, $p, $buildtype, $arch, $bconf_host, $arch_host) = @_;
if ($p->{'pkg'} eq '_product') {
$p->{'error'} = 'excluded';
return;
}
my $recipe = find_recipe($p, $buildtype);
if (!$recipe) {
$p->{'error'} = "no recipe found for buildtype $buildtype";
return;
}
$p->{'recipe'} = $recipe;
my $bt = Build::recipe2buildtype($recipe);
if (!$bt) {
$p->{'error'} = "do not know how to build $recipe";
return;
}
$p->{'buildtype'} = $bt;
my $d;
local $bconf->{'buildflavor'} = $p->{'flavor'};
eval {
$d = Build::parse_typed($bconf, "$p->{'dir'}/$recipe", $bt);
die("can not parse $recipe\n") unless $d;
if ($bconf_host && $d->{'nativebuild'}) {
$p->{'native'} = 1;
local $bconf_host->{'buildflavor'} = $p->{'flavor'};
$d = Build::parse_typed($bconf_host, "$p->{'dir'}/$recipe", $bt);
die("can not parse $recipe\n") unless $d;
$arch = $arch_host;
}
die("can not parse name from $recipe\n") unless $d->{'name'};
};
if ($@) {
$p->{'error'} = $@;
$p->{'error'} =~ s/\n.*//s;;
return;
}
my $version = defined($d->{'version'}) ? $d->{'version'} : 'unknown';
$p->{'version'} = $version;
$p->{'name'} = $d->{'name'};
$p->{'dep'} = $d->{'deps'};
$p->{'onlynative'} = $d->{'onlynative'} if $d->{'onlynative'};
$p->{'alsonative'} = $d->{'alsonative'} if $d->{'alsonative'};
if ($d->{'prereqs'}) {
my %deps = map {$_ => 1} (@{$d->{'deps'} || []}, @{$d->{'subpacks'} || []});
my @prereqs = grep {!$deps{$_} && !/^%/} @{$d->{'prereqs'}};
$p->{'prereq'} = \@prereqs if @prereqs;
}
if ($p->{'files'}->{'_service'}) {
push @{$p->{'buildtimeservice'}}, $_ for PBuild::Service::get_buildtimeservices($p);
}
my $imagetype = $bt eq 'kiwi' && $d->{'imagetype'} ? ($d->{'imagetype'}->[0] || '') : '';
if ($bt eq 'kiwi' && $imagetype eq 'product') {
$p->{'nodbgpkgs'} = 1 if defined($d->{'debugmedium'}) && $d->{'debugmedium'} <= 0;
$p->{'nosrcpkgs'} = 1 if defined($d->{'sourcemedium'}) && $d->{'sourcemedium'} <= 0;
}
my $myarch = $bconf->{'target'} ? (split('-', $bconf->{'target'}))[0] : $arch;
$p->{'error'} = 'excluded' if $d->{'exclarch'} && !grep {$_ eq $myarch} @{$d->{'exclarch'}};
$p->{'error'} = 'excluded' if $d->{'badarch'} && grep {$_ eq $myarch} @{$d->{'badarch'}};
$p->{'imagetype'} = $d->{'imagetype'} if $d->{'imagetype'};
$p->{'remoteassets'} = $d->{'remoteassets'} if $d->{'remoteassets'};
# check if we can build this
if ($bt eq 'kiwi' && $imagetype eq 'product') {
$p->{'error'} = 'cannot build kiwi products yet';
return;
}
}
# split host deps from deps if cross building
sub split_hostdeps {
my ($p, $bconf) = @_;
return if $p->{'buildtype'} eq 'kiwi' || $p->{'buildtype'} eq 'docker' || $p->{'buildtype'} eq 'fissile';
return if $p->{'native'};
return unless @{$p->{'dep'} || []};
my %onlynative = map {$_ => 1} @{$bconf->{'onlynative'} || []};
my %alsonative = map {$_ => 1} @{$bconf->{'alsonative'} || []};
for (@{$p->{'onlynative'} || []}) {
if (/^!(.*)/) {
delete $onlynative{$1};
} else {
$onlynative{$_} = 1;
}
}
for (@{$p->{'alsonative'} || []}) {
if (/^!(.*)/) {
delete $alsonative{$1};
} else {
$alsonative{$_} = 1;
}
}
my @hdep;
$p->{'dep_host'} = \@hdep;
return unless %onlynative || %alsonative;
@hdep = grep {$onlynative{$_} || $alsonative{$_}} @{$p->{'dep'}};
$p->{'dep'} = [ grep {!$onlynative{$_}} @{$p->{'dep'}}] if @hdep && %onlynative;
}
sub looks_like_packagedir {
my ($dir) = @_;
return 0 if -d "$dir/.pbuild";
return 0 if -d "$dir/_pbuild";
return 0 if -d "$dir/_config";
return 1 if -d "$dir/../.pbuild";
return 1 if -d "$dir/../_pbuild";
return 1 if -d "$dir/../_config";
my @files = PBuild::Util::ls($dir);
return 0 if grep {/^_build\./} @files;
for my $file (@files) {
return 1 if $file =~ /\.(?:spec|dsc|kiwi)$/;
return 1 if $file =~ /^mkosi\./;
return 1 if $file eq 'snapcraft.yaml' || $file eq 'appimage.yml';
return 1 if $file eq 'Dockerfile' || $file eq 'fissile.yml' || $file eq 'Chart.yml';
return 1 if $file eq 'PKGBUILD';
}
return 0;
}
1;
07070100000014000081a400000000000000000000000163e504b900002bb8000000000000000000000000000000000000001700000000PBuild/RemoteAssets.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 PBuild::RemoteAssets;
use POSIX;
use Digest::MD5 ();
use Digest::SHA ();
use MIME::Base64 ();
use Build::Download;
use PBuild::Util;
use PBuild::Cpio;
use PBuild::Zip;
use strict;
#
# rename a file unless the target already exists
#
sub rename_unless_present {
my ($old, $new) = @_;
die("link $old $new: $!\n") if !link($old, $new) && $! != POSIX::EEXIST;
unlink($old);
}
#
# create a obscpio asset from a directory
#
sub create_asset_from_dir {
my ($assetdir, $asset, $dir, $mtime) = @_;
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
PBuild::Util::mkdir_p($adir);
my $fd;
open($fd, '>', "$adir/.$assetid.$$") || die("$adir/.$assetid.$$: $!");
PBuild::Cpio::cpio_create($fd, $dir, 'mtime' => $mtime);
close($fd) || die("$adir/.$assetid.$$: $!");
rename_unless_present("$adir/.$assetid.$$", "$adir/$assetid");
}
#
# Recipe file remote asset handling
#
sub recipe_parse {
my ($p) = @_;
my @assets;
for my $s (@{$p->{'remoteassets'} || []}) {
my $url = $s->{'url'};
if ($url && $url =~ /^git(?:\+https?)?:.*\/([^\/]+?)(?:.git)?(?:\#[^\#\/]+)?$/) {
my $file = $1;
next if $p->{'files'}->{$file};
push @assets, { 'file' => $file, 'url' => $url, 'type' => 'url', 'isdir' => 1 };
next;
}
my $file = $s->{'file'};
if (($s->{'type'} || '' eq 'webcache')) {
next unless $s->{'url'};
$file = 'build-webcache-'.Digest::SHA::sha256_hex($s->{'url'});
}
next unless $s->{'url'} =~ /(?:^|\/)([^\.\/][^\/]+)$/s;
$file = $1 unless defined $file;
undef $url unless $url =~ /^https?:\/\/.*\/([^\.\/][^\/]+)$/s;
my $digest = $s->{'digest'};
next unless $digest || $url;
next unless $file =~ /^([^\.\/][^\/]+)$/s;
my $asset = { 'file' => $file };
$asset->{'digest'} = $digest if $digest;
$asset->{'url'} = $url if $url;
$asset->{'type'} = 'url' if $url;
push @assets, $asset;
}
return @assets;
}
# Go module proxy support
#
# Parse the go.sum file to find module information
#
sub golang_parse {
my ($p) = @_;
return unless $p->{'files'}->{'go.sum'} && !$p->{'files'}->{'vendor/'};
my $fd;
my @assets;
open ($fd, '<', "$p->{'dir'}/go.sum") || die("$p->{'dir'}/go.sum: $!\n");
my %mods;
while (<$fd>) {
chomp;
my @s = split(' ', $_);
next unless @s >= 3;
next unless $s[1] =~ /^v./;
next unless $s[2] =~ /^h1:[a-zA-Z0-9\+\/=]+/;
if ($s[1] =~ s/\/go.mod$//) {
$mods{"$s[0]/$s[1]"}->{'mod'} = $s[2];
} else {
$mods{"$s[0]/$s[1]"}->{'zip'} = $s[2];
$mods{"$s[0]/$s[1]"}->{'info'} = undef; # not protected by a checksum
}
}
for my $mod (sort keys %mods) {
my $l = $mods{$mod};
next unless $l->{'mod'}; # need at least the go.mod file
my $k = "$mod";
$k .= " $_ $mods{$mod}->{$_}" for sort keys %{$mods{$mod}};
my $file = "build-gomodcache/$mod";
$file =~ s/\//:/g;
my $assetid = Digest::MD5::md5_hex($k);
my $asset = { 'type' => 'golang', 'file' => $file, 'mod' => $mod, 'parts' => $mods{$mod}, 'isdir' => 1, 'immutable' => 1, 'assetid' => $assetid };
push @assets, $asset;
}
close $fd;
return @assets;
}
#
# Verify a file with the go module h1 checksum
#
sub verify_golang_h1 {
my ($file, $part, $h1) = @_;
my $fd;
open($fd, '<', $file) || die("file: $!\n");
my %content;
if ($part eq 'mod') {
$content{'go.mod'} = {};
} elsif ($part eq 'zip') {
my $l = PBuild::Zip::zip_list($fd);
for (@$l) {
next if $_->{'ziptype'} != 8; # only plain files
die("file $_->{'name'} exceeds size limit\n") if $_->{'size'} >= 500000000;
$content{$_->{'name'}} = $_;
}
}
die("$file: no content\n") unless %content;
my $data = '';
for my $file (sort keys %content) {
my $ctx = Build::Download::digest2ctx("sha256:");
if ($part eq 'zip') {
PBuild::Zip::zip_extract($fd, $content{$file}, 'writer' => sub {$ctx->add($_[0])});
} else {
my $chunk;
$ctx->add($chunk) while read($fd, $chunk, 65536);
}
$data .= $ctx->hexdigest()." $file\n";
}
close($fd);
die("not a h1 checksum: $h1\n") unless $h1 =~ /^h1:/;
my $digest = "sha256:".unpack("H*", MIME::Base64::decode_base64(substr($h1, 3)));
Build::Download::checkdigest($data, $digest);
}
#
# Fetch golang assets from a go module proxy
#
sub golang_fetch {
my ($p, $assetdir, $assets, $url) = @_;
my @assets = grep {$_->{'type'} eq 'golang'} @$assets;
return unless @assets;
print "fetching ".PBuild::Util::plural(scalar(@assets), 'asset')." from $url\n";
for my $asset (@assets) {
my $tmpdir = "$assetdir/.tmpdir.$$";
PBuild::Util::rm_rf($tmpdir);
my $mod = $asset->{'mod'};
my $moddir = $mod;
$moddir =~ s/\/[^\/]+$//;
$moddir =~ s/([A-Z])/'!'.lc($1)/ge;
my $vers = $mod;
$vers =~ s/.*\///;
$vers =~ s/([A-Z])/'!'.lc($1)/ge;
my $cname = "build-gomodcache";
PBuild::Util::mkdir_p("$tmpdir/$cname/$moddir/\@v");
my $parts = $asset->{'parts'};
for my $part (sort keys %$parts) {
my $proxyurl = "$url/$moddir/\@v/$vers.$part";
my $maxsize = $part eq 'zip' ? 500000000 : 16000000;
Build::Download::download($proxyurl, "$tmpdir/$cname/$moddir/\@v/$vers.$part", undef, 'retry' => 3, 'maxsize' => $maxsize);
my $h1 = $parts->{$part};
verify_golang_h1("$tmpdir/$cname/$moddir/\@v/$vers.$part", $part, $h1) if defined $h1;
}
my $mtime = 0; # we want reproducible cpio archives
create_asset_from_dir($assetdir, $asset, $tmpdir, $mtime);
PBuild::Util::rm_rf($tmpdir);
}
}
# Fedora FedPkg / lookaside cache support
#
# Parse a fedora "sources" asset reference file
#
sub fedpkg_parse {
my ($p) = @_;
return unless $p->{'files'}->{'sources'};
my $fd;
my @assets;
open ($fd, '<', "$p->{'dir'}/sources") || die("$p->{'dir'}/sources: $!\n");
while (<$fd>) {
chomp;
my $asset;
if (/^(\S+) \((.*)\) = ([0-9a-fA-F]{32,})$/s) {
$asset = { 'file' => $2, 'digest' => lc("$1:$3") };
} elsif (/^([0-9a-fA-F]{32}) (.*)$/) {
$asset = { 'file' => $2, 'digest' => lc("md5:$1") };
} else {
warn("unparsable line in 'sources' file: $_\n");
next;
}
push @assets, $asset if $asset->{'file'} =~ /^[^\.\/][^\/]*$/s;
}
close $fd;
return @assets;
}
#
# Get missing assets from a fedora lookaside cache server
#
sub fedpkg_fetch {
my ($p, $assetdir, $assets, $url) = @_;
my @assets = grep {$_->{'digest'}} @$assets;
return unless @assets;
die("need a parsed name to download fedpkg assets\n") unless $p->{'name'};
print "fetching ".PBuild::Util::plural(scalar(@assets), 'asset')." from $url\n";
for my $asset (@assets) {
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
PBuild::Util::mkdir_p($adir);
# $url/<name>/<file>/<hashtype>/<hash>/<file>
my $path = $asset->{'digest'};
$path =~ s/:/\//;
$path = "$p->{'name'}/$asset->{'file'}/$path/$asset->{'file'}";
$path = PBuild::Util::urlencode($path);
my $fedpkg_url = $url;
$fedpkg_url =~ s/\/?$/\/$path/;
if (Build::Download::download($fedpkg_url, "$adir/.$assetid.$$", undef, 'retry' => 3, 'digest' => $asset->{'digest'}, 'missingok' => 1)) {
rename_unless_present("$adir/.$assetid.$$", "$adir/$assetid");
}
}
}
# IPFS asset support (parsing is done in the source handler)
#
# Get missing assets from the InterPlanetary File System
#
sub ipfs_fetch {
my ($p, $assetdir, $assets) = @_;
my @assets = grep {($_->{'type'} || '') eq 'ipfs'} @$assets;
return unless @assets;
print "fetching ".PBuild::Util::plural(scalar(@assets), 'asset')." from the InterPlanetary File System\n";
# for now assume /ipfs is mounted...
die("/ipfs is not available\n") unless -d '/ipfs';
for my $asset (@assets) {
my $assetid = $asset->{'assetid'};
die("need a CID to download IPFS assets\n") unless $asset->{'cid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
PBuild::Util::mkdir_p($adir);
PBuild::Util::cp($asset->{'cid'}, "$adir/.$assetid.$$");
rename_unless_present("$adir/.$assetid.$$", "$adir/$assetid");
}
}
# Generic url asset support
sub fetch_git_asset {
my ($assetdir, $asset) = @_;
my $tmpdir = "$assetdir/.tmpdir.$$";
PBuild::Util::rm_rf($tmpdir);
PBuild::Util::mkdir_p($tmpdir);
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
my $file = $asset->{'file'};
PBuild::Util::mkdir_p($adir);
my $url = $asset->{'url'};
die unless $url =~ /^git(?:\+https?)?:/;
$url =~ s/^git\+//;
my @cmd = ('git', 'clone', '-q', '--recurse-submodules');
push @cmd, '-b', $1 if $url =~ s/#([^#]+)$//;
push @cmd, '--', $url, "$tmpdir/$file";
system(@cmd) && die("git clone failed: $!\n");
# get timestamp of last commit
my $pfd;
open($pfd, '-|', 'git', '-C', "$tmpdir/$file", 'log', '--pretty=format:%ct', '-1') || die("open: $!\n");
my $t = <$pfd>;
close($pfd);
chomp $t;
$t = undef unless $t && $t > 0;
if ($asset->{'donotpack'}) {
rename("$tmpdir/$file", "$adir/$assetid") || die("rename $tmpdir $adir/$assetid: $!\n");
} else {
create_asset_from_dir($assetdir, $asset, $tmpdir, $t);
}
PBuild::Util::rm_rf($tmpdir);
}
#
# generic resource fetcher
#
sub url_fetch {
my ($p, $assetdir, $assets) = @_;
my %tofetch_hosts;
# classify by hosts
my %tofetch_host;
for my $asset (grep {($_->{'type'} || '') eq 'url'} @$assets) {
my $url = $asset->{'url'};
die("need a url to download an asset\n") unless $url;
die("weird download url '$url' for asset\n") unless $url =~ /^(.*?\/\/.*?)\//;
push @{$tofetch_host{$1}}, $asset;
}
for my $hosturl (sort keys %tofetch_host) {
my $tofetch = $tofetch_host{$hosturl};
print "fetching ".PBuild::Util::plural(scalar(@$tofetch), 'asset')." from $hosturl\n";
for my $asset (@$tofetch) {
if ($asset->{'url'} =~ /^git(?:\+https?)?:/) {
fetch_git_asset($assetdir, $asset);
next;
}
my $assetid = $asset->{'assetid'};
my $adir = "$assetdir/".substr($assetid, 0, 2);
PBuild::Util::mkdir_p($adir);
if (Build::Download::download($asset->{'url'}, "$adir/.$assetid.$$", undef, 'retry' => 3, 'digest' => $asset->{'digest'}, 'missingok' => 1)) {
rename_unless_present("$adir/.$assetid.$$", "$adir/$assetid");
}
}
}
}
1;
07070100000015000081a400000000000000000000000163e504b900002952000000000000000000000000000000000000001900000000PBuild/RemoteRegistry.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 PBuild::RemoteRegistry;
use strict;
use LWP::UserAgent;
use URI;
use Build::Download;
use Build::SimpleJSON;
use PBuild::Verify;
eval { require JSON::XS };
*JSON::XS::decode_json = sub {die("JSON::XS is not available\n")} unless defined &JSON::XS::decode_json;
#
# mime types
#
my $mt_docker_manifest = 'application/vnd.docker.distribution.manifest.v2+json';
my $mt_docker_manifestlist = 'application/vnd.docker.distribution.manifest.list.v2+json';
my $mt_oci_manifest = 'application/vnd.oci.image.manifest.v1+json';
my $mt_oci_index = 'application/vnd.oci.image.index.v1+json';
#
# simple anon bearer authenticator
#
sub bearer_authenticate {
my($class, $ua, $proxy, $auth_param, $response, $request, $arg, $size) = @_;
return $response if $ua->{'bearer_authenticate_norecurse'};
local $ua->{'bearer_authenticate_norecurse'} = 1;
my $realm = $auth_param->{'realm'};
die("bearer auth did not provide a realm\n") unless $realm;
die("bearer realm is not http/https\n") unless $realm =~ /^https?:\/\//i;
my $auri = URI->new($realm);
my @afields;
for ('service', 'scope') {
push @afields, $_, $auth_param->{$_} if defined $auth_param->{$_};
}
print "requesting bearer auth from $realm [@afields]\n";
$auri->query_form($auri->query_form, @afields);
my $ares = $ua->get($auri);
return $response unless $ares->is_success;
my $reply = JSON::XS::decode_json($ares->decoded_content);
my $token = $reply->{'token'} || $reply->{'access_token'};
return $response unless $token;
my $url = $proxy ? $request->{proxy} : $request->uri_canonical;
my $host_port = $url->host_port;
my $h = $ua->get_my_handler('request_prepare', 'm_host_port' => $host_port, sub {
$_[0]{callback} = sub { $_[0]->header('Authorization' => "Bearer $token") };
});
return $ua->request($request->clone, $arg, $size, $response);
}
*LWP::Authen::Bearer::authenticate = \&bearer_authenticate;
#
# convert arch to goarch/govariant
#
sub arch2goarch {
my ($arch) = @_;
return ('amd64') if $arch eq 'x86_64';
return ('386') if $arch =~ /^i[3456]86$/;
return ('arm64', 'v8') if $arch eq 'aarch64';
return ('arm', "v$1") if $arch =~ /^armv(\d+)/;
return $arch;
}
#
# select a matching manifest from a manifest index (aka fat manifest)
#
sub select_manifest {
my ($arch, $manifests) = @_;
my ($goarch, $govariant) = arch2goarch($arch);
for my $m (@{$manifests || []}) {
next unless $m->{'digest'};
if ($m->{'platform'}) {
next if $m->{'platform'}->{'architecture'} ne $goarch;
next if $m->{'platform'}->{'variant'} && $govariant && $m->{'platform'}->{'variant'} ne $govariant;
}
return $m;
}
return undef;
}
sub fetch_manifest {
my ($repodir, $registry, @args) = @_;
return Build::Download::fetch(@args) if $registry !~ /docker.io\/?$/;
my ($data, $ct);
eval { ($data, $ct) = Build::Download::head(@args) };
die($@) if $@ && $@ !~ /401 Unauthorized/; # sigh, docker returns 401 for not-existing repositories
return undef unless $data;
my $digest = $data->{'docker-content-digest'};
return Build::Download::fetch(@args) unless $digest;
my $content = PBuild::Util::readstr("$repodir/manifest.$digest", 1);
if ($content) {
Build::Download::checkdigest($content, $digest);
return ($content, $ct);
}
($content, $ct) = Build::Download::fetch(@args);
return undef unless $content;
Build::Download::checkdigest($content, $digest);
PBuild::Util::mkdir_p($repodir);
PBuild::Util::writestr("$repodir/.manifest.$digest.$$", "$repodir/manifest.$digest", $content);
return ($content, $ct);
}
#
# query a registry about a container
#
sub queryremotecontainer {
my ($ua, $arch, $repodir, $registry, $repotag) = @_;
$repotag .= ":latest" unless $repotag =~ /:[^\/:]+$/;
die unless $repotag =~ /^(.*):([^\/:]+)$/;
my ($repository, $tag) = ($1, $2);
$repository = "library/$repository" if $repository !~ /\// && $registry =~ /docker.io\/?$/;
# strip domain part if it matches the registry url
my $registrydomain = $registry;
$registrydomain =~ s/^[^\/]+\/\///;
$registrydomain =~ s/\/.*//;
$repository = $2 if $repository =~ /^([^\/]+)\/(.+)$/s && $1 eq $registrydomain;
my @accept = ($mt_docker_manifestlist, $mt_docker_manifest, $mt_oci_index, $mt_oci_manifest);
my ($data, $ct) = fetch_manifest($repodir, $registry, "$registry/v2/$repository/manifests/$tag",
'ua' => $ua, 'accept' => \@accept, 'missingok' => 1);
return undef unless defined $data;
die("no content type set in answer\n") unless $ct;
if ($ct eq $mt_docker_manifestlist || $ct eq $mt_oci_index) {
# fat manifest, select the one we want
my $r = JSON::XS::decode_json($data);
my $manifest = select_manifest($arch, $r->{'manifests'} || []);
return undef unless $manifest;
@accept = ($mt_docker_manifest, $mt_oci_manifest);
($data, $ct) = fetch_manifest($repodir, $registry, "$registry/v2/$repository/manifests/$manifest->{'digest'}",
'ua' => $ua, 'accept' => \@accept);
die("no content type set in answer\n") unless $ct;
}
die("unknown content type\n") unless $ct eq $mt_docker_manifest || $ct eq $mt_oci_manifest;
my $r = JSON::XS::decode_json($data);
my @blobs;
die("manifest has no config\n") unless $r->{'config'};
push @blobs, $r->{'config'};
push @blobs, @{$r->{'layers'} || []};
PBuild::Verify::verify_digest($_->{'digest'}) for @blobs;
my $id = $blobs[0]->{'digest'};
$id =~ s/.*://;
$id = substr($id, 0, 32);
my $name = $repotag;
$name =~ s/[:\/]/-/g;
$name = "container:$name";
my $version = 0;
my @provides = ("$name = $version");
push @provides, "container:$repotag" unless $name eq "container:$repotag";
my $q = {
'name' => $name,
'version' => $version,
'arch' => 'noarch',
'source' => $name,
'provides' => \@provides,
'hdrmd5' => $id,
'location' => $repository,
'blobs' => \@blobs,
'containertags' => [ $repotag ],
};
return $q;
}
#
# get data from a registry for a set of containers
#
sub fetchrepo {
my ($bconf, $arch, $repodir, $url, $repotags) = @_;
my @bins;
my $ua = Build::Download::create_ua();
for my $repotag (@{$repotags || []}) {
my $bin = queryremotecontainer($ua, $arch, $repodir, $url, $repotag);
push @bins, $bin if $bin;
}
return \@bins;
}
#
# download the blobs needed to reconstruct a container
#
sub fetchbinaries {
my ($repo, $bins) = @_;
my $repodir = $repo->{'dir'};
my $url = $repo->{'url'};
my $nbins = @$bins;
die("bad repo\n") unless $url;
my %tofetch;
for my $bin (@$bins) {
my $blobs = $bin->{'blobs'};
die unless $blobs;
for my $blob (@$blobs) {
my $digest = $blob->{'digest'};
die unless $digest;
next if -s "$repodir/blob.$digest";
$tofetch{"$bin->{'location'}/$digest"} = 1;
}
}
return unless %tofetch;
my @tofetch = sort keys %tofetch;
print "fetching ".PBuild::Util::plural(scalar(@tofetch), 'container blob')." from $url\n";
my $ua = Build::Download::create_ua();
PBuild::Util::mkdir_p($repodir);
for my $tofetch (@tofetch) {
next unless $tofetch =~ /^(.*)\/(.*)?$/;
my ($repository, $digest) = ($1, $2);
next if -s "$repodir/blob.$digest";
Build::Download::download("$url/v2/$repository/blobs/$digest", "$repodir/.blob.$digest.$$", "$repodir/blob.$digest", 'digest' => $digest, 'ua' => $ua);
}
}
#
# create the head/pad data for a tar file entry
#
sub maketarhead {
my ($name, $size, $mtime) = @_;
my $h = "\0\0\0\0\0\0\0\0" x 64;
my $pad = '';
return ("$h$h") unless defined $name;
my $tartype = '0';
die("name too big\n") if length($name) > 100;
my $mode = sprintf("%07o", 0x81a4);
my $fsize = sprintf("%011o", $size);
my $fmtime = sprintf("%011o", $mtime);
substr($h, 0, length($name), $name);
substr($h, 100, length($mode), $mode);
substr($h, 108, 15, "0000000\0000000000"); # uid/gid
substr($h, 124, length($fsize), $fsize);
substr($h, 136, length($fmtime), $fmtime);
substr($h, 148, 8, ' ');
substr($h, 156, 1, $tartype);
substr($h, 257, 8, "ustar\00000"); # magic/version
substr($h, 329, 15, "0000000\0000000000"); # major/minor
substr($h, 148, 7, sprintf("%06o\0", unpack("%16C*", $h)));
$pad = "\0" x (512 - $size % 512) if $size % 512;
return ($h, $pad);
}
#
# reconstruct a container from blobs
#
sub construct_containertar {
my ($repodir, $q, $dst) = @_;
die("construct_containertar: $q->{'name'}: not a container\n") unless $q->{'name'} =~ /^container:/;
my $fd;
open ($fd, '>', $dst) || die("$dst: $!\n");
my $mtime = time();
my $blobs = $q->{'blobs'};
die unless $blobs;
for my $blob (@$blobs) {
my $digest = $blob->{'digest'};
die unless $digest;
my $bfd;
open ($bfd, '<', "$repodir/blob.$digest") || die("$repodir/blob.$digest: $!\n");
my @s = stat($bfd);
die unless @s;
my $size = $s[7];
my ($head, $pad) = maketarhead($digest, $size, $mtime);
print $fd $head;
while ($size > 0) {
my $chunk = $size > 16384 ? 16384 : $size;
my $b = '';
die("unexpected read error in blob\n") unless sysread($bfd, $b, $chunk);
print $fd $b;
$size -= length($b);
}
print $fd $pad;
close($bfd);
}
my @digests = map {$_->{'digest'}} @$blobs;
my $configdigest = shift @digests;
my $manifest = {
'Config' => $configdigest,
'Layers' => \@digests,
'RepoTags' => $q->{'containertags'},
'_order' => [ 'Config', 'RepoTags', 'Layers' ],
};
my $manifest_json = Build::SimpleJSON::unparse([ $manifest ], 'ugly' => 1);
my ($head, $pad) = maketarhead('manifest.json', length($manifest_json), $mtime);
print $fd "$head$manifest_json$pad".maketarhead();
close($fd) || die;
}
1;
07070100000016000081a400000000000000000000000163e504b900004574000000000000000000000000000000000000001500000000PBuild/RemoteRepo.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 PBuild::RemoteRepo;
use strict;
use Encode;
use IO::Uncompress::Gunzip ();
use Digest::MD5 ();
use Build;
use Build::Rpmmd;
use Build::Archrepo;
use Build::Debrepo;
use Build::Deb;
use Build::Susetags;
use Build::Zypp;
use Build::Modules;
use Build::Download;
use PBuild::Util;
use PBuild::Verify;
use PBuild::OBS;
use PBuild::Cando;
my @binsufs = qw{rpm deb pkg.tar.gz pkg.tar.xz pkg.tar.zst};
my $binsufsre = join('|', map {"\Q$_\E"} @binsufs);
sub download_zypp {
my ($url, $dest, $digest) = @_;
die("do not know how to download $url\n") unless $url =~ m#^zypp://([^/]+)/((?:.*/)?([^/]+)\.rpm)$#;
my ($repo, $path, $pkg) = ($1, $2, $3);
die("bad dest $dest for $pkg\n") if $dest !~ /^(.*)\/[^\/]*\Q$pkg\E\.rpm$/;
my $dir = $1;
system('/usr/bin/zypper', '--no-refresh', '-q', '--pkg-cache-dir', $dir, 'download', '-r', $repo, $pkg)
&& die("zypper download $pkg failed\n");
die("zypper download of $pkg did not create $dir/$repo/$path\n") unless -f "$dir/$repo/$path";
Build::Download::checkfiledigest("$dir/$repo/$path", $digest) if $digest;
rename("$dir/$repo/$path", $dest) || die("rename $dir/$repo/$path $dest: $!\n");
}
sub download {
my ($url, $dest, $destfinal, $digest, $ua) = @_;
return download_zypp($url, $destfinal || $dest, $digest) if $url =~ /^zypp:\/\//;
Build::Download::download($url, $dest, $destfinal, 'digest' => $digest, 'ua' => $ua, 'retry' => 3);
}
sub addpkg {
my ($bins, $pkg, $locprefix, $archfilter) = @_;
return unless defined($pkg->{'name'}) && defined($pkg->{'arch'});
return if $pkg->{'arch'} eq 'src' || $pkg->{'arch'} eq 'nosrc';
return if $archfilter && !$archfilter->{$pkg->{'arch'}};
$locprefix = '' unless defined $locprefix;
$pkg->{'location'} = "$locprefix$pkg->{'location'}" if defined $locprefix;
delete $pkg->{'filename'}; # just in case
delete $pkg->{'packid'}; # just in case
push @$bins, $pkg;
}
sub fetchrepo_arch {
my ($url, $tmpdir, %opts) = @_;
die("could not determine reponame from url $url\n") unless "/$url/" =~ /.*\/([^\/]+)\/os\//;
my $reponame = $1;
$url .= '/' unless $url =~ /\/$/;
download("$url$reponame.db", "$tmpdir/repo.db");
my @bins;
Build::Archrepo::parse("$tmpdir/repo.db", sub { addpkg(\@bins, $_[0], $url) }, 'addselfprovides' => 1, 'normalizedeps' => 1);
return \@bins;
}
sub fetchrepo_debian {
my ($url, $tmpdir, %opts) = @_;
my ($baseurl, $disturl, $components) = Build::Debrepo::parserepourl($url);
die("fetchrepo_debian needs an architecture\n") unless $opts{'arch'};
my $basearch = Build::Deb::basearch($opts{'arch'});
my @bins;
for my $component (@$components) {
unlink("$tmpdir/Packages.gz");
if ($component eq '.') {
download("${disturl}Packages.gz", "$tmpdir/Packages.gz");
die("Packages.gz missing\n") unless -s "$tmpdir/Packages.gz";
} else {
download("$disturl$component/binary-$basearch/Packages.gz", "$tmpdir/Packages.gz");
die("Packages.gz missing for basearch $basearch, component $component\n") unless -s "$tmpdir/Packages.gz";
}
Build::Debrepo::parse("$tmpdir/Packages.gz", sub { addpkg(\@bins, $_[0], $baseurl) }, 'addselfprovides' => 1, 'withchecksum' => 1, 'normalizedeps' => 1);
}
return \@bins;
}
sub open_uncompressed {
my ($filename) = @_;
my $fh;
open($fh, '<', $filename) or die("Error opening $filename: $!\n");
if ($filename =~ /\.gz$/) {
$fh = IO::Uncompress::Gunzip->new($fh) or die("Error opening $filename: $IO::Uncompress::Gunzip::GunzipError\n");
}
return $fh;
}
sub fetchrepo_rpmmd {
my ($url, $tmpdir, %opts) = @_;
my $baseurl = $url;
$baseurl .= '/' unless $baseurl =~ /\/$/;
my @resources;
download("${baseurl}repodata/repomd.xml", "$tmpdir/repomd.xml") unless $opts{'iszypp'};
my $cookie = Digest::MD5::md5_hex(PBuild::Util::readstr("$tmpdir/repomd.xml"));
my $oldrepo = $opts{'oldrepo'};
return $oldrepo if $oldrepo && $oldrepo->{'cookie'} && $cookie eq $oldrepo->{'cookie'};
Build::Rpmmd::parse_repomd("$tmpdir/repomd.xml", \@resources);
my @primaryfiles = grep {$_->{'type'} eq 'primary' && defined($_->{'location'})} @resources;
my $archfilter = $opts{'archfilter'};
my @bins;
for my $f (@primaryfiles) {
my $u = "$f->{'location'}";
utf8::downgrade($u);
next unless $u =~ /(primary\.xml(?:\.gz)?)$/s;
my $fn = $1;
if ($opts{'iszypp'}) {
$fn = $u;
$fn =~ s/.*\///s;
die("zypp repo $url is not up to date, please refresh first\n") unless -s "$tmpdir/$fn";
} else {
die("primary file $u does not have a checksum\n") unless $f->{'checksum'} && $f->{'checksum'} =~ /:(.*)/;
$fn = "$1-$fn";
download("${baseurl}/$f->{'location'}", "$tmpdir/$fn", undef, $f->{'checksum'});
}
my $fh = open_uncompressed("$tmpdir/$fn");
Build::Rpmmd::parse($fh, sub { addpkg(\@bins, $_[0], $baseurl, $archfilter) }, 'addselfprovides' => 1, 'withchecksum' => 1);
last;
}
my @moduleinfofiles = grep {$_->{'type'} eq 'modules' && defined($_->{'location'})} @resources;
for my $f (@moduleinfofiles) {
my $u = "$f->{'location'}";
utf8::downgrade($u);
next unless $u =~ /(modules\.yaml(?:\.gz)?)$/s;
my $fn = $1;
die("zypp:// repos do not support module data\n") if $opts{'iszypp'};
die("modules file $u does not have a checksum\n") unless $f->{'checksum'} && $f->{'checksum'} =~ /:(.*)/;
$fn = "$1-$fn";
download("${baseurl}/$f->{'location'}", "$tmpdir/$fn", undef, $f->{'checksum'});
my $fh = open_uncompressed("$tmpdir/$fn");
my $moduleinfo = {};
Build::Modules::parse($fh, $moduleinfo);
push @bins, { 'name' => 'moduleinfo:', 'data' => $moduleinfo };
last;
}
return { 'bins' => \@bins, 'cookie' => $cookie };
}
sub fetchrepo_susetags {
my ($url, $tmpdir, %opts) = @_;
my $descrdir = 'suse/setup/descr';
my $datadir = 'suse';
my $baseurl = $url;
$baseurl .= '/' unless $baseurl =~ /\/$/;
download("${baseurl}$descrdir/packages.gz", "$tmpdir/packages.gz") unless $opts{'iszypp'};
my $archfilter = $opts{'archfilter'};
my @bins;
Build::Susetags::parse("$tmpdir/packages.gz", sub {
my $xurl = $baseurl;
$xurl =~ s/1\/$/$_[0]->{'medium'}/ if $_[0]->{'medium'};
$xurl .= "$datadir/" if $datadir;
addpkg(\@bins, $_[0], $xurl, $archfilter)
}, 'addselfprovides' => 1, 'withchecksum' => 1);
return \@bins;
}
sub fetchrepo_zypp {
my ($url, $tmpdir, %opts) = @_;
die("zypp repo must start with zypp://\n") unless $url =~ /^zypp:\/\/([^\/]*)/;
my $repo = Build::Zypp::parserepo($1);
my $type = $repo->{'type'};
my $zyppcachedir = "/var/cache/zypp/raw/$repo->{'name'}";
if (!$type) {
$type = 'yast2' if -e "$zyppcachedir/suse/setup/descr";
$type = 'rpm-md' if -e "$zyppcachedir/repodata";
}
die("could not determine repo type for '$repo->{'name'}'\n") unless $type;
if($type eq 'rpm-md') {
die("zypp repo $url is not up to date, please refresh first\n") unless -s "$zyppcachedir/repodata/repomd.xml";
return fetchrepo_rpmmd("zypp://$repo->{'name'}", "$zyppcachedir/repodata", %opts, 'iszypp' => 1);
} else {
die("zypp repo $url is not up to date, please refresh first\n") unless -s "$zyppcachedir/suse/setup/descr/packages.gz";
return fetchrepo_susetags("zypp://$repo->{'name'}", "$zyppcachedir/suse/setup/descr", %opts, 'iszypp' => 1);
}
}
sub fetchrepo_obs {
my ($url, $tmpdir, %opts) = @_;
my $modules = $opts{'modules'};
my $bins = PBuild::OBS::fetch_repodata($url, $tmpdir, $opts{'arch'}, $opts{'opts'}, $modules);
@$bins = sort {$a->{'name'} cmp $b->{'name'}} @$bins;
for (@$bins) {
delete $_->{'filename'}; # just in case
delete $_->{'packid'}; # just in case
}
push @$bins, { 'name' => 'moduleinfo:', 'modules' => $modules } if @{$modules || []};
return $bins;
}
#
# Generate the on-disk filename from the metadata
#
sub calc_binname {
my ($bin) = @_;
my $suf;
if ($bin->{'name'} =~ /^container:/) {
$suf = 'tar';
} else {
die("bad location: $bin->{'location'}\n") unless $bin->{'location'} =~ /\.($binsufsre)$/;
$suf = $1;
}
my $binname = $bin->{'version'};
$binname = "$bin->{'epoch'}:$binname" if $bin->{'epoch'};
$binname .= "-$bin->{'release'}" if defined $bin->{'release'};
$binname .= ".$bin->{'arch'}" if $bin->{'arch'};
$binname = "$bin->{'name'}-$binname.$suf";
$binname = "$bin->{'hdrmd5'}-$binname" if $binname =~ s/^container:// && $bin->{'hdrmd5'};
return $binname;
}
#
# Replace already downloaded entries in the metadata
#
sub replace_with_local {
my ($repodir, $bins) = @_;
my $bad;
my %files = map {$_ => 1} PBuild::Util::ls($repodir);
delete $files{'_metadata'};
delete $files{'.tmp'};
for my $bin (@$bins) {
next if $bin->{'name'} eq 'moduleinfo:';
my $file = $bin->{'filename'};
if (defined $file) {
if (!$files{$file}) {
$bad = 1;
next;
}
$files{$file} = 2;
next;
}
$file = calc_binname($bin);
next unless $files{$file};
if ($bin->{'name'} =~ /^container:/) {
delete $bin->{'id'};
$bin->{'filename'} = $file;
next;
}
eval {
my $q = querybinary($repodir, $file);
%$bin = %$q;
$files{$file} = 2;
};
if ($@) {
warn($@);
unlink($file);
}
}
for my $file (grep {$files{$_} == 1} sort keys %files) {
unlink("$repodir/$file");
}
return $bad ? 0 : 1;
}
#
# Guess the repotype from the build config
#
sub guess_repotype {
my ($bconf, $buildtype) = @_;
return undef unless $bconf;
for (@{$bconf->{'repotype'} || []}) {
return $_ if $_ eq 'arch' || $_ eq 'debian' || $_ eq 'hdlist2' || $_ eq 'rpm-md';
}
return 'arch' if ($bconf->{'binarytype'} || '') eq 'arch';
return 'debian' if ($bconf->{'binarytype'} || '') eq 'deb';
$buildtype ||= $bconf->{'type'};
return 'rpm-md' if ($buildtype || '') eq 'spec';
return 'debian' if ($buildtype || '') eq 'dsc';
return 'arch' if ($buildtype || '') eq 'arch';
return undef;
}
#
# Get repository metadata for a remote repository
#
sub fetchrepo {
my ($bconf, $arch, $repodir, $url, $buildtype, $opts) = @_;
my $repotype;
$repotype = 'zypp' if $url =~ /^zypp:/;
$repotype = 'obs' if $url =~ /^obs:/;
my $archfilter;
if ($url =~ /^(arch|debian|hdlist2|rpmmd|rpm-md|suse)(?:\+archfilter=([^\@\/]+))?\@(.*)$/) {
$repotype = $1;
$archfilter = [ split(',', $2) ] if $2;
$url = $3;
}
$repotype ||= guess_repotype($bconf, $buildtype) || 'rpmmd';
$archfilter ||= [ PBuild::Cando::archfilter($arch) ] if $repotype ne 'obs';
if ($archfilter) {
$archfilter = { map {$_ => 1} @$archfilter };
$archfilter->{$_} = 1 for qw{all any noarch};
}
my $modules = [ PBuild::Util::unify(sort(@{$bconf->{'modules'} || []})) ];
my $repofile = "$repodir/_metadata";
my $cookie;
my $oldrepo;
if (-s $repofile) {
$oldrepo = PBuild::Util::retrieve($repofile, 1);
undef $oldrepo unless ref($oldrepo) eq 'HASH' && $oldrepo->{'bins'};
if ($oldrepo && $repotype eq 'obs') {
# obs repo data changes with the modules, so be careful
my $oldbins = $oldrepo->{'bins'};
my $repomodules = [];
if (@$oldbins && $oldbins->[-1]->{'name'} eq 'moduleinfo:') {
$repomodules = $oldbins->[-1]->{'modules'} || [];
}
undef $oldrepo if join(',', @$modules) ne join(',', @$repomodules);
}
undef $oldrepo if $oldrepo && !replace_with_local($repodir, $oldrepo->{'bins'});
return $oldrepo->{'bins'} if $oldrepo && $opts->{'no-repo-refresh'};
}
my $tmpdir = "$repodir/.tmp";
PBuild::Util::cleandir($tmpdir) if -e $tmpdir;
PBuild::Util::mkdir_p($tmpdir);
my $repo;
my %opts = ( 'arch' => $arch, 'archfilter' => $archfilter, 'modules' => $modules, 'oldrepo' => $oldrepo , 'opts' => $opts);
if ($repotype eq 'rpmmd' || $repotype eq 'rpm-md') {
$repo = fetchrepo_rpmmd($url, $tmpdir, %opts);
} elsif ($repotype eq 'debian') {
$repo = fetchrepo_debian($url, $tmpdir, %opts);
} elsif ($repotype eq 'arch') {
$repo = fetchrepo_arch($url, $tmpdir, %opts);
} elsif ($repotype eq 'suse') {
$repo = fetchrepo_susetags($url, $tmpdir, %opts);
} elsif ($repotype eq 'zypp') {
$repo = fetchrepo_zypp($url, $tmpdir, %opts);
} elsif ($repotype eq 'obs') {
$repo = fetchrepo_obs($url, $tmpdir, %opts);
} else {
die("unsupported repotype '$repotype'\n");
}
$repo = { 'bins' => $repo } if $repo && ref($repo) ne 'HASH';
die unless $repo && $repo->{'bins'};
replace_with_local($repodir, $repo->{'bins'}) unless $repo == $oldrepo;
PBuild::Util::store("$repodir/._metadata.$$", $repofile, $repo);
return $repo->{'bins'};
}
#
# Expand the special zypp:// repo to all enabled zypp repositories
#
sub expand_zypp_repo {
my ($repos) = @_;
return unless grep {/^zypp:\/{0,2}$/} @{$repos || []};
my @r;
for my $url (@$repos) {
if ($url =~ /^zypp:\/{0,2}$/) {
for my $r (Build::Zypp::parseallrepos()) {
push @r, "zypp://$r->{'name'}" if $r->{'enabled'};
}
} else {
push @r, $url;
}
}
@$repos = @r;
}
#
# Check if the downloaded package matches the repository metadata
#
sub is_matching_binary {
my ($b1, $b2) = @_;
return 0 if $b1->{'name'} ne $b2->{'name'};
return 0 if $b1->{'arch'} ne $b2->{'arch'};
return 0 if $b1->{'version'} ne $b2->{'version'};
return 0 if ($b1->{'epoch'} || 0) ne ($b2->{'epoch'} || 0);
return 0 if (defined $b1->{'release'} ? $b1->{'release'} : '__undef__') ne (defined $b2->{'release'} ? $b2->{'release'} : '__undef__');
return 1;
}
#
# Query dependencies of a downloaded binary package
#
sub querybinary {
my ($dir, $file) = @_;
my @s = stat("$dir/$file");
die("$dir/$file: $!\n") unless @s;
my $id = "$s[9]/$s[7]/$s[1]";
my $data;
my $leadsigmd5;
die("$dir/$file: no hdrmd5\n") unless Build::queryhdrmd5("$dir/$file", \$leadsigmd5);
$data = Build::query("$dir/$file", 'evra' => 1, 'conflicts' => 1, 'weakdeps' => 1, 'addselfprovides' => 1, 'filedeps' => 1, 'normalizedeps' => 1);
die("$dir/$file: query failed\n") unless $data;
PBuild::Verify::verify_nevraquery($data);
$data->{'leadsigmd5'} = $leadsigmd5 if $leadsigmd5;
$data->{'filename'} = $file;
$data->{'id'} = $id;
return $data;
}
#
# Check if the downloaded binary matches and replace the stub with it
#
sub fetchbinaries_replace {
my ($repodir, $tmpname, $binname, $bin) = @_;
Build::Download::checkfiledigest("$repodir/$tmpname", $bin->{'checksum'}) if $bin->{'checksum'};
my $q = querybinary($repodir, $tmpname);
die("downloaded binary $binname does not match repository metadata\n") unless is_matching_binary($bin, $q);
rename("$repodir/$tmpname", "$repodir/$binname") || die("rename $repodir/$tmpname $repodir/$binname\n");
$q->{'filename'} = $binname;
%$bin = %$q; # inline replace!
}
#
# Download missing binaries in batches from a remote obs instance
#
sub fetchbinaries_obs {
my ($repo, $bins, $ua) = @_;
my $url;
my %names;
for my $bin (@$bins) {
next if $bin->{'filename'};
my $location = $bin->{'location'};
die("missing location for binary $bin->{'name'}\n") unless $location;
next if $location =~ /^zypp:/ || $location !~ /(.+)\/_repository\//;
my $binname = calc_binname($bin);
PBuild::Verify::verify_filename($binname);
$url = $1 unless defined $url;
next if $1 ne $url;
$names{$bin->{'name'}} = [ ".$$.$binname", $binname, $bin ];
}
return unless %names;
my $repodir = $repo->{'dir'};
PBuild::Util::mkdir_p($repodir);
PBuild::OBS::fetch_binaries($url, $repodir, \%names, \&fetchbinaries_replace, $ua);
}
#
# Download missing binaries from a remote repository
#
sub fetchbinaries {
my ($repo, $bins) = @_;
my $repodir = $repo->{'dir'};
my $url = $repo->{'url'};
die("bad repo\n") unless $url;
print "fetching ".PBuild::Util::plural(scalar(@$bins), 'binary')." from $url\n";
PBuild::Util::mkdir_p($repodir);
my $ua = Build::Download::create_ua();
fetchbinaries_obs($repo, $bins, $ua) if $url =~ /^obs:/;
for my $bin (@$bins) {
next if $bin->{'filename'};
my $location = $bin->{'location'};
die("missing location for binary $bin->{'name'}\n") unless $location;
die("bad location: $location\n") unless $location =~ /^(?:https?|zypp):\/\//;
my $binname = calc_binname($bin);
PBuild::Verify::verify_filename($binname);
my $tmpname = ".$$.$binname";
if ($bin->{'name'} =~ /^container:/) {
# we cannot query containers, just download and set the filename
die("container has no hdrmd5\n") unless $bin->{'hdrmd5'};
download($location, "$repodir/$tmpname", "$repodir/$binname", "md5:$bin->{'hdrmd5'}", $ua);
delete $bin->{'id'};
$bin->{'filename'} = $binname;
next;
}
download($location, "$repodir/$tmpname", undef, undef, $ua);
fetchbinaries_replace($repodir, $tmpname, $binname, $bin);
}
# update _metadata
PBuild::Util::store("$repodir/._metadata.$$", "$repodir/_metadata", $repo->{'bins'});
}
1;
07070100000017000081a400000000000000000000000163e504b9000017c7000000000000000000000000000000000000001200000000PBuild/RepoMgr.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 PBuild::RepoMgr;
use strict;
use PBuild::Util;
use PBuild::RemoteRepo;
use PBuild::RemoteRegistry;
use PBuild::Verify;
#
# Create the repo manager
#
sub create {
return bless {};
}
#
# Add a remote repository to the manager
#
sub addremoterepo {
my ($repos, $bconf, $myarch, $builddir, $repourl, $buildtype, $opts) = @_;
return addemptyrepo($repos) if $repourl =~ /^empty:/;
my $id = Digest::MD5::md5_hex("$myarch/$repourl");
return $repos->{$id} if $repos->{$id};
my $repodir = "$builddir/.pbuild/_base/$id";
my $bins = PBuild::RemoteRepo::fetchrepo($bconf, $myarch, $repodir, $repourl, $buildtype, $opts);
$_->{'repoid'} = $id for @$bins;
my $repo = { 'dir' => $repodir, 'bins' => $bins, 'url' => $repourl, 'arch' => $myarch, 'type' => 'repo', 'repoid' => $id };
$repos->{$id} = $repo;
return $repo;
}
#
# Add a remote registry to the manager
#
sub addremoteregistry {
my ($repos, $bconf, $myarch, $builddir, $registry, $tags) = @_;
my $repourl = $registry;
$repourl = "https://$repourl" unless $repourl =~ /^[^\/]+\/\//;
my $id = Digest::MD5::md5_hex("$myarch/$repourl");
return $repos->{$id} if $repos->{$id};
my $repodir = "$builddir/.pbuild/_base/$id";
my $bins = PBuild::RemoteRegistry::fetchrepo($bconf, $myarch, $repodir, $repourl, $tags);
$_->{'repoid'} = $id for @$bins;
my $repo = { 'dir' => $repodir, 'bins' => $bins, 'url' => $repourl, 'arch' => $myarch, 'type' => 'registry', 'repoid' => $id };
$repos->{$id} = $repo;
return $repo;
}
#
# Add a local repository to the manager
#
sub addlocalrepo {
my ($repos, $bconf, $myarch, $builddir, $pkgsrc, $pkgs) = @_;
my $id = "$myarch/local";
die("local repo already added\n") if $repos->{$id};
my $bins = PBuild::LocalRepo::fetchrepo($bconf, $myarch, $builddir, $pkgsrc, $pkgs);
$_->{'repoid'} = $id for @$bins;
my $repo = { 'dir' => $builddir, 'bins' => $bins, 'arch' => $myarch, 'type' => 'local', 'repoid' => $id };
$repos->{$id} = $repo;
return $repo;
}
#
# Add an emptt repository to the manager
#
sub addemptyrepo {
my ($repos) = @_;
my $id = 'empty';
return $repos->{$id} if $repos->{$id};
my $repo = { 'bins' => [], 'type' => 'empty', 'repoid' => $id };
$repos->{$id} = $repo;
return $repo;
}
#
# Update the local reposiory with new binary data
#
sub updatelocalrepo {
my ($repos, $bconf, $myarch, $builddir, $pkgsrc, $pkgs) = @_;
my $id = "$myarch/local";
my $repo = $repos->{$id};
die("local repo does not exist\n") unless $repo;
my $bins = PBuild::LocalRepo::fetchrepo($bconf, $myarch, $builddir, $pkgsrc, $pkgs);
$_->{'repoid'} = $id for @$bins;
$repo->{'bins'} = $bins;
}
#
# Fetch missing binaries from a remote repo/registry
#
sub getremotebinaries {
my ($repos, $bins) = @_;
my %tofetch;
for my $q (@$bins) {
push @{$tofetch{$q->{'repoid'}}}, $q unless $q->{'filename'};
}
for my $repoid (sort {$a cmp $b} keys %tofetch) {
my $repo = $repos->{$repoid};
die("bad repoid $repoid\n") unless $repo;
if ($repo->{'type'} eq 'repo') {
PBuild::RemoteRepo::fetchbinaries($repo, $tofetch{$repoid});
} elsif ($repo->{'type'} eq 'registry') {
PBuild::RemoteRegistry::fetchbinaries($repo, $tofetch{$repoid});
} else {
die("unknown repo type $repo->{'type'}\n");
}
$_->{'repoid'} = $repoid for @{$tofetch{$repoid}};
}
}
#
# Setup the repo/containers directories used for image/container builds
#
sub copyimagebinaries {
my ($repos, $bins, $dstdir) = @_;
PBuild::Util::mkdir_p("$dstdir/repos/pbuild/pbuild");
for my $q (@$bins) {
my $repo = $repos->{$q->{'repoid'}};
die("package $q->{'name'} has no repo\n") unless $repo;
my $to;
if ($q->{'name'} =~ /^container:/) {
PBuild::Util::mkdir_p("$dstdir/containers");
$to = "$q->{'name'}.tar";
$to =~ s/^container://;
$to =~ s/[\/:]/_/g;
PBuild::Verify::verify_filename($to);
$to = "$dstdir/containers/$to";
} else {
die("package $q->{'name'} is not available\n") unless $q->{'filename'};
PBuild::Verify::verify_filename($q->{'filename'});
$to = "$dstdir/repos/pbuild/pbuild/$q->{'filename'}";
}
if ($repo->{'type'} eq 'registry') {
PBuild::RemoteRegistry::construct_containertar($repo->{'dir'}, $q, $to);
next;
}
die("package $q->{'name'} is not available\n") unless $q->{'filename'};
PBuild::Verify::verify_filename($q->{'filename'});
my $from = "$repo->{'dir'}/$q->{'filename'}";
$from = "$repo->{'dir'}/$q->{'packid'}/$q->{'filename'}" if $q->{'packid'};
$from = "$repo->{'dir'}/$q->{'packid'}/$q->{'lnk'}" if $q->{'packid'} && $q->{'lnk'}; # obsbinlnk
PBuild::Util::cp($from, $to);
}
}
#
# Return the on-disk locations for a set of binary names
#
sub getbinarylocations {
my ($repos, $bins) = @_;
my %locations;
for my $q (@$bins) {
my $repo = $repos->{$q->{'repoid'}};
die("package $q->{'name'} has no repo\n") unless $repo;
die("package $q->{'name'} is not available\n") unless $q->{'filename'};
if ($q->{'packid'}) {
$locations{$q->{'name'}} = "$repo->{'dir'}/$q->{'packid'}/$q->{'filename'}";
} else {
$locations{$q->{'name'}} = "$repo->{'dir'}/$q->{'filename'}";
}
}
return \%locations;
}
1;
07070100000018000081a400000000000000000000000163e504b900001dc7000000000000000000000000000000000000001400000000PBuild/Repoquery.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 PBuild::Repoquery;
use strict;
use Build;
use Build::Rpm;
use PBuild::Expand;
use PBuild::Modules;
#
# match a parsed complex dependency against a set of provides
#
sub matchdeps_cplx {
my ($pp, $r, $binarytype) = @_;
if ($r->[0] == 0) {
for my $p (@$pp) {
return 1 if Build::matchsingledep($p, $r->[1], $binarytype);
}
} elsif ($r->[0] == 1 || $r->[0] == 2) { # and or
return 1 if matchdeps_cplx($pp, $r->[1], $binarytype);
return 1 if matchdeps_cplx($pp, $r->[2], $binarytype);
} elsif ($r->[0] == 3 || $r->[0] == 4) { # if unless
return 1 if matchdeps_cplx($pp, $r->[1], $binarytype);
return 1 if @$r == 4 && matchdeps_cplx($pp, $r->[3], $binarytype);
} elsif ($r->[0] == 6) { # with
return 1 if matchdeps_cplx($pp, $r->[1], $binarytype) && matchdeps_cplx($pp, $r->[2], $binarytype);
} elsif ($r->[0] == 7) { # without
return 1 if matchdeps_cplx($pp, $r->[1], $binarytype) && !matchdeps_cplx($pp, $r->[2], $binarytype);
}
return 0;
}
#
# match a dependency against a single provides
#
sub matchdep {
my ($p, $d, $binarytype) = @_;
if ($d =~ /\|/) {
# debian or
for my $od (split(/\s*\|\s*/, $d)) {
return 1 if Build::matchsingledep($p, $od, $binarytype);
}
return 0;
}
return Build::matchsingledep($p, $d, $binarytype);
}
#
# compare to packages by epoch/version/release
#
sub evrcmp {
my ($obin, $bin, $verscmp) = @_;
my $evr = $bin->{'version'};
$evr = "$bin->{'epoch'}:$evr" if $bin->{'epoch'};
$evr .= "-$bin->{'release'}" if defined $bin->{'release'};
my $oevr = $obin->{'version'};
$oevr = "$obin->{'epoch'}:$oevr" if $obin->{'epoch'};
$oevr .= "-$obin->{'release'}" if defined $obin->{'release'};
return 0 if $oevr eq $evr;
return $verscmp->($oevr, $evr) || $oevr cmp $evr;
}
#
# compare to packages by architecure (noarch > otherarch)
#
sub archcmp {
my ($obin, $bin) = @_;
my $arch = $bin->{'arch'} || '';
$arch = 'noarch' if !$arch || $arch eq 'all' || $arch eq 'any';
my $oarch = $obin->{'arch'} || '';
$oarch = 'noarch' if !$oarch || $oarch eq 'all' || $oarch eq 'any';
return -1 if $arch eq 'noarch' && $oarch ne 'noarch';
return 1 if $oarch eq 'noarch' && $arch ne 'noarch';
return $oarch cmp $arch;
}
#
# return true if a package is not selected by the configured modules
#
sub ispruned {
my ($modules, $moduledata, $bin) = @_;
return 0 unless $moduledata;
my @modules = PBuild::Modules::getmodules($moduledata, $bin);
return 0 unless @modules;
my $pruned = PBuild::Modules::prune_to_modules($modules, $moduledata, [ $bin ]);
return @$pruned ? 0 : 1;
}
#
# match the available packages against a given query
#
sub repoquery {
my ($bconf, $myarch, $repos, $query, $opts) = @_;
my @query = @{$query || []};
die("Please specify a query\n") unless @query;
for (@query) {
if (/^(name|requires|provides|conflicts|recommends|supplements|obsoletes):(.*)$/) {
$_ = [ $1, $2 ];
} else {
$_ = [ 'provides', $_ ];
}
if ($_->[1] =~ /^\(.*\)$/) {
$_->[3] = Build::Rpm::parse_rich_dep($_->[1]);
} elsif ($_->[1] =~ /\|/) {
$_->[2] = undef; # debian or
} elsif ($_->[1] !~ /^(.*?)\s*([<=>]{1,2})\s*(.*?)$/) {
$_->[2] = $_->[1];
} else {
$_->[2] = $1;
}
if ($_->[0] ne 'name' && $_->[0] ne 'provides') {
die("provides '$_->[1]' cannot be complex\n") if $_->[3];
die("provides '$_->[1]' cannot use debian or\n") if $_->[1] =~ /\|/;
}
}
my $binarytype = $bconf->{'binarytype'};
my $verscmp = $binarytype eq 'deb' ? \&Build::Deb::verscmp : \&Build::Rpm::verscmp;
my $packs = PBuild::Expand::configure_repos($bconf, $repos);
for my $repo (@$repos) {
my $bins = $repo->{'bins'} || [];
my $moduledata;
$moduledata = $bins->[-1]->{'data'} if @$bins && $bins->[-1]->{'name'} eq 'moduleinfo:';
my $repoprinted;
for my $bin (@$bins) {
next if $bin->{'name'} eq 'moduleinfo:';
my $match;
for my $q (@query) {
my $dd;
if ($q->[0] eq 'name') {
my $evr = $bin->{'version'};
$evr = "$bin->{'epoch'}:$evr" if $bin->{'epoch'};
$evr .= "-$bin->{'release'}" if defined $bin->{'release'};
$dd = [ "$bin->{'name'} = $evr" ];
} else {
$dd = $bin->{$q->[0]};
}
next unless $dd;
if ($q->[0] eq 'name' || $q->[0] eq 'provides') {
if ($q->[3]) {
if (matchdeps_cplx($dd, $q->[3], $binarytype)) {
$match = 1;
last;
}
next;
}
if ($q->[1] =~ /\|/) {
# debian or, cannot pre-filter
for my $d (@$dd) {
if (matchdep($d, $q->[1], $binarytype)) {
$match = 1;
last;
}
}
next;
}
for my $d (grep {/^\Q$q->[2]\E/} @$dd) {
if (matchdep($d, $q->[1], $binarytype)) {
$match = 1;
last;
}
}
} else {
for my $d (grep {/^\Q$q->[2]\E/} @$dd) {
if (matchdep($q->[1], $d, $binarytype)) {
$match = 1;
last;
}
}
}
last if $match;
}
next unless $match;
my $excluded;
my $taken = $packs->{$bin->{'name'}};
if (($taken || 0) != $bin) {
$excluded = 'unknown' unless $taken;
$excluded = 'unselected module' if !$excluded && ispruned($bconf->{'modules'}, $moduledata, $bin);
$excluded = 'repo layering' if !$excluded && $taken->{'repoid'} ne $bin->{'repoid'};
$excluded = 'smaller version' if !$excluded && evrcmp($taken, $bin, $verscmp) >= 0;
$excluded = 'smaller architecture' if !$excluded && archcmp($taken, $bin) >= 0;
$excluded ||= 'unknown';
}
my $evr = $bin->{'version'};
$evr = "$bin->{'epoch'}:$evr" if $bin->{'epoch'};
$evr .= "-$bin->{'release'}" if defined $bin->{'release'};
my $nevra = "$bin->{'name'}-$evr.$bin->{'arch'}";
my $from = $repo->{'type'} eq 'local' ? 'build result' : $repo->{'url'};
if ($opts->{'details'}) {
print "$nevra\n";
print " repo: $from\n";
print " excluded: $excluded\n" if $excluded;
my @modules;
@modules = PBuild::Modules::getmodules($moduledata, $bin) if $moduledata;
if (@modules) {
print " modules:\n";
print " - $_\n" for @modules;
}
for my $d (qw{provides requires conflicts obsoletes recommends supplements suggests enhances}) {
my $dd = $bin->{$d};
next unless @{$dd || []};
print " $d:\n";
print " - $_\n" for @$dd;
}
} else {
if (!$repoprinted) {
print "repo: $from\n";
$repoprinted = 1;
}
if ($excluded) {
$excluded = '<v' if $excluded eq 'smaller version';
$excluded = '<a' if $excluded eq 'smaller architecture';
$excluded = '<r' if $excluded eq 'repo layering';
$excluded = '!m' if $excluded eq 'unselected module';
$excluded = '??' if length($excluded) != 2;
} else {
$excluded = ' ';
}
print " $excluded $nevra\n";
}
}
}
}
1;
07070100000019000081a400000000000000000000000163e504b900000ae1000000000000000000000000000000000000001100000000PBuild/Result.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 PBuild::Result;
use strict;
use PBuild::Util;
my @code_order = qw{broken succeeded failed unresolvable blocked scheduled waiting building excluded disabled locked};
my %code_failures = map {$_ => 1} qw{broken failed unresolvable};
sub print_result {
my ($opts, $builddir) = @_;
my $r = PBuild::Util::retrieve("$builddir/.pbuild/_result", 1);
die("pbuild has not run yet for $builddir\n") unless $r;
$opts->{'result-pkg'} = [ $opts->{'single'} ] if $opts->{'single'};
my %codefilter = map {$_ => 1} @{$opts->{'result-code'} || []};
my %pkgfilter = map {$_ => 1} @{$opts->{'result-pkg'} || []};
my $found_failures = 0;
my %codes_seen;
for my $pkg (sort keys %$r) {
next if %pkgfilter && !$pkgfilter{$pkg};
my $code = $r->{$pkg}->{'code'} || 'unknown';
$found_failures = 1 if $code_failures{$code};
next if %codefilter && !$codefilter{'all'} && !$codefilter{$code};
push @{$codes_seen{$code}}, $pkg;
}
my @codes_seen;
for (@code_order) {
push @codes_seen, $_ if $codes_seen{$_};
}
@codes_seen = PBuild::Util::unify(@codes_seen, sort keys %codes_seen);
for my $code (@codes_seen) {
my $ncode = @{$codes_seen{$code}};
printf "%-10s %d\n", "$code:", $ncode;
next if ($code eq 'disabled' || $code eq 'excluded') && !$codefilter{$code};
next unless $opts->{'result-code'} || $opts->{'result-pkg'};
for my $pkg (@{$codes_seen{$code}}) {
if (!$opts->{'terse'}) {
my $details = $r->{$pkg}->{'details'};
if ($details) {
print " $pkg ($details)\n";
} else {
print " $pkg\n";
}
} else {
print " $pkg\n";
}
}
}
return $found_failures;
}
sub has_failed {
my ($opts, $builddir, $pkg) = @_;
my $r = PBuild::Util::retrieve("$builddir/.pbuild/_result", 1);
die("pbuild has not run yet for $builddir\n") unless $r;
my $code = $r->{$pkg}->{'code'} || 'unknown';
return $code_failures{$code} ? 1 : 0;
}
1;
0707010000001a000081a400000000000000000000000163e504b90000073e000000000000000000000000000000000000001200000000PBuild/Service.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 PBuild::Service;
use strict;
use PBuild::Util;
use PBuild::Structured;
my $dtd_services = [
'services' =>
[[ 'service' =>
'name',
'mode', # "localonly" is skipping this service on server side, "trylocal" is trying to merge changes directly in local files, "disabled" is just skipping it
[[ 'param' =>
'name',
'_content'
]],
]],
];
#
# Parse a _service file from a package
#
sub parse_service {
my ($p) = @_;
return undef unless $p->{'files'}->{'_service'};
return PBuild::Structured::readxml("$p->{'dir'}/_service", $dtd_services, 1, 1);
}
#
# return the buildtime services of a package
#
sub get_buildtimeservices {
my ($p) = @_;
return () unless $p->{'files'}->{'_service'};
my @bt;
my $services = parse_service($p);
for my $service (@{$services->{'service'} || []}) {
push @bt, $service->{'name'} if ($service->{'mode'} || '') eq 'buildtime';
}
return sort(PBuild::Util::unify(@bt));
}
1;
0707010000001b000081a400000000000000000000000163e504b9000010a0000000000000000000000000000000000000001100000000PBuild/Source.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 PBuild::Source;
use strict;
use Digest::MD5;
use PBuild::Util;
sub find_packages {
my ($dir) = @_;
my @pkgs;
for my $pkg (sort(PBuild::Util::ls($dir))) {
next if $pkg =~ /^[\._]/;
next unless -d "$dir/$pkg";
push @pkgs, $pkg;
}
return @pkgs;
}
sub gendigest {
my ($fn) = @_;
my $fd;
open($fd, '<', $fn) || die("$fn: $!\n");
my $ctx = Digest::MD5->new;
$ctx->addfile($fd);
close $fd;
return $ctx->hexdigest();
}
sub genlnkdigest {
my ($fn) = @_;
my $lnk = readlink($fn);
die("$fn: $!\n") unless defined $lnk;
return Digest::MD5::md5_hex($lnk);
}
sub gendirdigest {
my ($dir) = @_;
my %files;
for my $file (sort(PBuild::Util::ls($dir))) {
my @s = lstat("$dir/$file");
if (!@s) {
warn("$dir: $!\n");
next;
}
if (-l _) {
$files{$file} = genlnkdigest("$dir/$file");
} elsif (-d _) {
$files{"$file/"} = gendirdigest("$dir/$file");
} elsif (-f _) {
$files{$file} = gendigest("$dir/$file");
}
}
return calc_srcmd5(\%files);
}
sub get_scm_controlled {
my ($dir) = @_;
return {} unless -d "$dir/.git" || -d "$dir/../.git";
my $fd;
my @controlled;
#open($fd, '-|', 'git', '-C', $dir, 'ls-files', '-z') || die("git: $!\n");
open($fd, '-|', 'git', '-C', $dir, 'ls-tree', '--name-only', '-z', 'HEAD') || die("git: $!\n");
my $d = '';
1 while sysread($fd, $d, 8192, length($d));
close($fd) || die("git ls-tree failed: $?\n");
my @d = split("\0", $d);
s/\/.*// for @d;
return { map {$_ => 1} @d };
}
sub is_subdir_build {
my ($dir, $files) = @_;
my @sd = grep {$_ eq 'dist' || $_ eq 'package'} @$files;
return 0 unless @sd;
return 0 if grep {/\.spec$/} @$files;
for my $sd (@sd) {
return 1 if grep {/\.spec$/} PBuild::Util::ls("$dir/$sd");
}
}
sub list_package {
my ($dir) = @_;
my %files;
my @assets;
my $controlled;
my @all = sort(PBuild::Util::ls($dir));
for my $file (@all) {
next if $file eq '_meta' || $file eq '.git';
next if $file =~ /\n/;
my @s = lstat("$dir/$file");
die("$dir/$file: $!\n") unless @s;
my $lnk;
if (-l _) {
$lnk = readlink("$dir/$file");
die("readlink $dir/$file: $!\n") unless defined $lnk;
if ($lnk =~ /^(\/ipfs\/.+)$/s) {
my $assetid = Digest::MD5::md5_hex($1);
push @assets, { 'file' => $file, 'cid' => $1, 'assetid' => $assetid, 'immutable' => 1, 'type' => 'ipfs' };
next;
}
}
if (-l _ || -d _ || $file =~ /^\./) {
if (!$controlled) {
$controlled = get_scm_controlled($dir);
if (!%$controlled && is_subdir_build($dir, \@all)) {
$controlled = { map {$_ => 1} @all };
}
# redo stat because get_scm_controlled changed it
lstat("$dir/$file") || die("$dir/$file: $!\n");
}
if (!$controlled->{$file}) {
next if -d _ || $file =~ /^\./;
@s = stat("$dir/$file");
next unless @s && -f _; # follow links to files
}
}
if (-l _) {
$files{"$file/"} = genlnkdigest("$dir/$file");
} elsif (-d _) {
$files{"$file/"} = gendirdigest("$dir/$file");
} elsif (-f _) {
$files{$file} = gendigest("$dir/$file");
}
}
$files{"debian/control"} = gendigest("$dir/debian/control") if $files{'debian/'} && -s "$dir/debian/control";
return \%files, \@assets;
}
sub calc_srcmd5 {
my ($files) = @_;
my $meta = '';
$meta .= "$files->{$_} $_\n" for sort keys %$files;
return Digest::MD5::md5_hex($meta);
}
1;
0707010000001c000081a400000000000000000000000163e504b900001168000000000000000000000000000000000000001500000000PBuild/Structured.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 PBuild::Structured;
use Build::SimpleXML;
use PBuild::Util;
use strict;
#
# Convert dtd to a hash mapping elements/attributes to multi/subdtd tupels
#
sub _toknown {
my ($me, @dtd) = @_;
my %known = map {ref($_) ? (!@$_ ? () : (ref($_->[0]) ? $_->[0]->[0] : $_->[0] => $_)) : ($_=> $_)} @dtd;
for my $v (values %known) {
if (!ref($v)) {
$v = 0; # string
} elsif (@$v == 1 && !ref($v->[0])) {
$v = 1; # array of strings
} elsif (@$v == 1) {
$v = [1, _toknown(@{$v->[0]}) ]; # array of sub-elements
} else {
$v = [0, _toknown(@$v) ]; # sub-element
}
}
$known{'.'} = $me;
return \%known;
}
#
# Process a single element
#
sub _workin {
my ($known, $out, $in, $allowunknown) = @_;
die("bad input\n") unless ref($in) eq 'HASH';
for my $x (sort keys %$in) {
my $k = $known->{$x};
if ($x eq '_content') {
$in->{$x} =~ s/^\s+//s;
$in->{$x} =~ s/\s+$//s;
next if $in->{$x} eq '';
}
if (!defined($k) && defined($known->{''})) {
$k = $known->{''};
die("bad dtd\n") unless ref($k);
if (!$k->[0]) {
die("element '' must be singleton\n") if exists $out->{''};
$out = $out->{''} = {};
} else {
push @{$out->{''}}, {};
$out = $out->{''}->[-1];
}
$known= $k->[1];
$k = $known->{$x};
}
if (!defined($k)) {
next if $allowunknown;
die("unknown element: $x\n");
}
my $v = $in->{$x};
if (ref($v) eq '') {
# attribute
if (ref($k)) {
die("attribute '$x' must be element\n") if @{$known->{$x}} > 1 || ref($known->{$x}->[0]);
push @{$out->{$x}}, $v;
} else {
die("attribute '$x' must be singleton\n") if exists $out->{$x};
$out->{$x} = $v;
}
next;
}
die("bad input\n") unless ref($v) eq 'ARRAY';
for (@$v) {
die("bad element '$x'\n") if ref($_) ne 'HASH';
}
if (!ref($k)) {
for (@$v) {
die("element '$x' has subelements\n") if %$_ && (!exists($_->{'_content'}) || keys(%$_) != 1);
}
if (!$k) {
die("element '$x' must be singleton\n") unless @$v == 1 && !exists($out->{$x});
$out->{$x} = $v->[0]->{'_content'};
} else {
push @{$out->{$x}}, map {$_->{'_content'}} @$v;
}
} else {
if (!$k->[0]) {
die("element '$x' must be singleton\n") unless @$v == 1 && !exists($out->{$x});
$out->{$x} = {};
_workin($k->[1], $out->{$x}, $v->[0], $allowunknown);
} else {
for (@$v) {
push @{$out->{$x}}, {};
_workin($k->[1], $out->{$x}->[-1], $_, $allowunknown);
}
}
}
}
}
#
# Postprocess parsed xml data by matching it to a dtd
#
sub xmlpostprocess {
my ($d, $dtd, $allowunknown) = @_;
my $me = $dtd->[0];
my $known = {$me => [ 0, _toknown(@$dtd) ] };
my $out = {};
_workin($known, $out, $d, $allowunknown);
die("xml is not a '$me' element\n") unless defined $out->{$me};
return $out->{$me};
}
#
# Convert data from xml
#
sub fromxml {
my ($d, $dtd, $nonfatal, $allowunknown) = @_;
eval {
$d = Build::SimpleXML::parse($d, 'notrim' => 1);
$d = xmlpostprocess($d, $dtd, $allowunknown);
};
if ($@) {
return undef if $nonfatal;
die($@);
}
return $d;
}
#
# Read a file containing XML, parse and postprocess it according to the provided dtd
#
sub readxml {
my ($fn, $dtd, $nonfatal, $allowunknown) = @_;
my $d = PBuild::Util::readstr($fn, $nonfatal);
return $d unless defined $d;
eval {
$d = Build::SimpleXML::parse($d, 'notrim' => 1);
$d = xmlpostprocess($d, $dtd, $allowunknown);
};
if ($@) {
return undef if $nonfatal;
die("$fn: $@");
}
return $d;
}
1;
0707010000001d000081a400000000000000000000000163e504b9000016ea000000000000000000000000000000000000000f00000000PBuild/Util.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 PBuild::Util;
use strict;
use POSIX;
use Storable ();
sub unify {
my %h = map {$_ => 1} @_;
return grep(delete($h{$_}), @_);
}
sub clone {
return Storable::dclone($_[0]);
}
sub writestr {
my ($fn, $fnf, $d) = @_;
my $f;
open($f, '>', $fn) || die("$fn: $!\n");
if (length($d)) {
(syswrite($f, $d) || 0) == length($d) || die("$fn write: $!\n");
}
close($f) || die("$fn close: $!\n");
return unless defined $fnf;
rename($fn, $fnf) || die("rename $fn $fnf: $!\n");
}
sub readstr {
my ($fn, $nonfatal) = @_;
my $f;
if (!open($f, '<', $fn)) {
die("$fn: $!\n") unless $nonfatal;
return undef;
}
my $d = '';
1 while sysread($f, $d, 8192, length($d));
close $f;
return $d;
}
sub touch($) {
my ($file) = @_;
if (-e $file) {
my $t = time();
utime($t, $t, $file);
} else {
# create new file, mtime is anyway current
my $f;
open($f, '>>', $file) || die("$file: $!\n");
close($f) || die("$file close: $!\n");
}
}
sub ls {
my $d;
opendir($d, $_[0]) || return ();
my @r = grep {$_ ne '.' && $_ ne '..'} readdir($d);
closedir $d;
return @r;
}
sub mkdir_p {
my ($dir) = @_;
return 1 if -d $dir;
my $pdir;
if ($dir =~ /^(.+)\//) {
$pdir = $1;
mkdir_p($pdir) || return undef;
}
while (!mkdir($dir, 0777)) {
my $e = $!;
return 1 if -d $dir;
if (defined($pdir) && ! -d $pdir) {
mkdir_p($pdir) || return undef;
next;
}
$! = $e;
warn("mkdir: $dir: $!\n");
return undef;
}
return 1;
}
sub cleandir {
my ($dir) = @_;
my $ret = 1;
return 1 unless -d $dir;
for my $c (ls($dir)) {
if (! -l "$dir/$c" && -d _) {
cleandir("$dir/$c");
$ret = undef unless rmdir("$dir/$c");
} else {
$ret = undef unless unlink("$dir/$c");
}
}
return $ret;
}
sub rm_rf {
my ($file) = @_;
my @s = lstat($file);
if (@s && -d _) {
cleandir($file);
die("rmdir $file: $!\n") unless rmdir($file);
} elsif (@s) {
unlink($file) || die("unlink $file: $!\n");
}
}
sub xfork {
while (1) {
my $pid = fork();
return $pid if defined $pid;
die("fork: $!\n") if $! != POSIX::EAGAIN;
sleep(5);
}
}
sub cp {
my ($from, $to, $tof) = @_;
my ($f, $t);
open($f, '<', $from) || die("$from: $!\n");
open($t, '>', $to) || die("$to: $!\n");
my $buf;
while (sysread($f, $buf, 8192)) {
(syswrite($t, $buf) || 0) == length($buf) || die("$to write: $!\n");
}
close($f);
close($t) || die("$to: $!\n");
if (defined($tof)) {
rename($to, $tof) || die("rename $to $tof: $!\n");
}
}
sub cp_a {
my ($from, $to, $tof) = @_;
rm_rf($to);
system('cp', '-a', '--', $from, $to) && die("cp $from $to: $?\n");
if (defined($tof)) {
rename($to, $tof) || die("rename $to $tof: $!\n");
}
}
sub store {
my ($fn, $fnf, $dd) = @_;
if (!Storable::nstore($dd, $fn)) {
die("nstore $fn: $!\n");
}
return unless defined $fnf;
$! = 0;
rename($fn, $fnf) || die("rename $fn $fnf: $!\n");
}
sub retrieve {
my ($fn, $nonfatal) = @_;
my $dd;
if (!$nonfatal) {
$dd = ref($fn) ? Storable::fd_retrieve($fn) : Storable::retrieve($fn);
die("retrieve $fn: $!\n") unless $dd;
} else {
eval {
$dd = ref($fn) ? Storable::fd_retrieve($fn) : Storable::retrieve($fn);
};
if (!$dd && $nonfatal == 2) {
if ($@) {
warn($@);
} else {
warn("retrieve $fn: $!\n");
}
}
}
return $dd;
}
sub identical {
my ($d1, $d2, $except, $subexcept) = @_;
if (!defined($d1)) {
return defined($d2) ? 0 : 1;
}
return 0 unless defined($d2);
my $r = ref($d1);
return 0 if $r ne ref($d2);
if ($r eq '') {
return 0 if $d1 ne $d2;
} elsif ($r eq 'HASH') {
my %k = (%$d1, %$d2);
for my $k (keys %k) {
next if $except && $except->{$k};
return 0 unless identical($d1->{$k}, $d2->{$k}, $subexcept, $subexcept);
}
} elsif ($r eq 'ARRAY') {
return 0 unless @$d1 == @$d2;
for (my $i = 0; $i < @$d1; $i++) {
return 0 unless identical($d1->[$i], $d2->[$i], $subexcept, $subexcept);
}
} else {
return 0;
}
return 1;
}
sub store_unless_identical {
my ($fn, $fnf, $dd, $olddd) = @_;
$olddd ||= retrieve(defined($fnf) ? $fnf : $fn, 1);
store($fn, $fnf, $dd) unless identical($dd, $olddd);
}
sub isotime {
my ($t) = @_;
my @lt = localtime($t || time());
return sprintf "%04d-%02d-%02d %02d:%02d:%02d", $lt[5] + 1900, $lt[4] + 1, @lt[3,2,1,0];
}
sub urlencode {
my ($str, $iscgi) = @_;
if ($iscgi) {
$str =~ s/([\000-\037<>;\"#\?&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
$str =~ tr/ /+/;
} else {
$str =~ s/([\000-\040<>;\"#\?&\+=%[\177-\377])/sprintf("%%%02X",ord($1))/sge;
}
return $str;
}
sub urldecode {
my ($str, $iscgi) = @_;
$str =~ tr/+/ / if $iscgi;
$str =~ s/%([a-fA-F0-9]{2})/chr(hex($1))/sge;
return $str;
}
sub plural {
my ($n, $what) = @_;
return "$n $what" if $n == 1;
return "$n ${what}ies" if $what =~ s/y$//;
return "$n ${what}s";
}
1;
0707010000001e000081a400000000000000000000000163e504b900000df9000000000000000000000000000000000000001100000000PBuild/Verify.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 PBuild::Verify;
use strict;
sub verify_simple {
my $name = $_[0];
die("illegal characters\n") if $name =~ /[^\-+=\.,0-9:%{}\@#%A-Z_a-z~\200-\377]/s;
}
sub verify_filename {
my $filename = $_[0];
die("filename is empty\n") unless defined($filename) && $filename ne '';
die("filename '$filename' is illegal\n") if $filename =~ /[\/\000-\037]/;
die("filename '$filename' is illegal\n") if $filename =~ /^\./;
}
sub verify_arch {
my $arch = $_[0];
die("arch is empty\n") unless defined($arch) && $arch ne '';
die("arch '$arch' is illegal\n") if $arch =~ /[\/:\.\000-\037]/;
die("arch '$arch' is illegal\n") unless $arch;
die("arch '$arch' is too long\n") if length($arch) > 200;
verify_simple($arch);
}
sub verify_packid {
my $packid = $_[0];
die("packid is empty\n") unless defined($packid) && $packid ne '';
die("packid '$packid' is too long\n") if length($packid) > 200;
if ($packid =~ /(?<!^_product)(?<!^_patchinfo):./) {
# multibuild case: first part must be a vaild package, second part simple label
die("packid '$packid' is illegal\n") unless $packid =~ /\A([^:]+):([^:]+)\z/s;
my ($p1, $p2) = ($1, $2);
die("packid '$packid' is illegal\n") if $p1 eq '_project' || $p1 eq '_pattern';
verify_packid($p1);
die("packid '$packid' is illegal\n") unless $p2 =~ /\A[^_\.\/:\000-\037][^\/:\000-\037]*\z/;
return;
}
return if $packid =~ /\A(?:_product|_pattern|_project|_patchinfo)\z/;
return if $packid =~ /\A(?:_product:|_patchinfo:)[^_\.\/:\000-\037][^\/:\000-\037]*\z/;
die("packid '$packid' is illegal\n") if $packid =~ /[\/:\000-\037]/;
die("packid '$packid' is illegal\n") if $packid =~ /^[_\.]/;
die("packid '$packid' is illegal\n") unless $packid;
}
sub verify_digest {
my $digest = $_[0];
die("digest is empty\n") unless defined($digest) && $digest ne '';
die("digest '$digest' is illegal\n") unless $digest =~ /^(?:[a-zA-Z0-9]+:)?[a-fA-F0-9]+$/s;
}
sub verify_nevraquery {
my ($q) = @_;
verify_arch($q->{'arch'});
die("binary has no name\n") unless defined $q->{'name'};
die("binary has no version\n") unless defined $q->{'version'};
my $f = "$q->{'name'}-$q->{'version'}";
$f .= "-$q->{'release'}" if defined $q->{'release'};
verify_filename($f);
verify_simple($f);
}
sub verify_multibuild {
my ($mb) = @_;
die("multibuild cannot have both package and flavor elements\n") if $mb->{'package'} && $mb->{'flavor'};
for my $packid (@{$mb->{'package'} || []}) {
verify_packid($packid);
die("packid $packid is illegal in multibuild\n") if $packid =~ /:/;
}
for my $packid (@{$mb->{'flavor'} || []}) {
verify_packid($packid);
die("flavor $packid is illegal in multibuild\n") if $packid =~ /:/;
}
}
1;
0707010000001f000081a400000000000000000000000163e504b900001cfe000000000000000000000000000000000000000e00000000PBuild/Zip.pm################################################################
#
# Copyright (c) 2022 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 PBuild::Zip;
use strict;
sub readbytes {
my ($handle, $size, $pos) = @_;
die("zip_list: file too small\n") if defined($pos) && $pos < 0;
return '' if $size == 0;
die("zip readbytes: invalid size $size\n") if $size < 0 || $size >= 0x1000000;
seek($handle, $pos, 0) || die("seek: $!\n") if defined($pos);
my $d;
my $r = read($handle, $d, $size);
die("zip read: $!\n") unless defined $r;
die("zip read: unexpeced EOF ($r != $size)\n") unless $r == $size;
return $d;
}
sub quadit {
die("quad overflow\n") if $_[1] >= 65536;
$_[0] = $_[0] + $_[1] * 65536 * 65536;
}
sub extract_stored {
my ($handle, $size, $csize, $writer) = @_;
while ($size > 0) {
my $chunksize = $size > 65536 ? 65536 : $size;
$writer->(readbytes($handle, $chunksize));
$size -= $chunksize;
}
}
sub extract_inflate {
my ($handle, $size, $csize, $writer) = @_;
return unless $size > 0;
require Compress::Raw::Zlib unless defined &Compress::Raw::Zlib::Inflate;
my ($decomp, $status) = Compress::Raw::Zlib::Inflate->new('-WindowBits' => -Compress::Raw::Zlib::MAX_WBITS(), '-Bufsize' => 65536);
die("Compress::Raw::Zlib::Inflate::new failed\n") unless $decomp && $status == Compress::Raw::Zlib::Z_OK();
while ($size > 0 || $csize > 0) {
die("unexpected EOF\n") unless $csize > 0;
my $chunksize = $csize > 65536 ? 65536 : $csize;
my $chunk = readbytes($handle, $chunksize);
$csize -= $chunksize;
my $infchunk = '';
($status) = $decomp->inflate($chunk, $infchunk);
die("decompression error\n") unless $status == Compress::Raw::Zlib::Z_OK() || $status == Compress::Raw::Zlib::Z_STREAM_END();
die("decompression returned too much data\n") if length($infchunk) > $size;
$writer->($infchunk) if length($infchunk);
$size -= length($infchunk);
last if $status == Compress::Raw::Zlib::Z_STREAM_END();
}
die("decompressed returned too few data\n") if $size;
}
sub zip_extract {
my ($handle, $ent, %opts) = @_;
die("cannot extract this type of entry\n") if defined($ent->{'ziptype'}) && $ent->{'ziptype'} != 8 && $ent->{'ziptype'} != 10;
my $data = '';
return $data if $ent->{'size'} == 0;
my $writer = $opts{'writer'} || sub { $data .= $_[0] };
die("missing local header offset\n") unless defined $ent->{'lhdroffset'};
my $lfh = readbytes($handle, 30, $ent->{'lhdroffset'});
my ($lfh_magic, $lfh_vneed, $lfh_bits, $lfh_comp, $lfh_time, $lfh_date, $lfh_crc, $lfh_csize, $lfh_size, $lfh_fnsize, $lfh_extrasize) = unpack('VvvvvvVVVvv', $lfh);
die("missing local file header\n") unless $lfh_magic == 0x04034b50;
readbytes($handle, $lfh_fnsize + $lfh_extrasize); # verify file name?
# can't use lfh size values because they may be in the trailing data descriptor
if ($lfh_comp == 8) {
extract_inflate($handle, $ent->{'size'}, $ent->{'csize'}, $writer);
} elsif ($lfh_comp == 0) {
extract_stored($handle, $ent->{'size'}, $ent->{'csize'}, $writer);
} else {
die("unsupported compression type $lfh_comp\n");
}
return $data;
}
sub zip_list {
my ($handle) = @_;
my @s = stat($handle);
die("zip_list: $!\n") unless @s;
die("zip_list: only files supported\n") unless -f _;
my $zipsize = $s[7];
my $eocd = readbytes($handle, 22, $zipsize - 22);
my ($eocd_magic, $eocd_disk, $eocd_cddisk, $eocd_cdcnt, $eocd_tcdcnt, $cd_size, $cd_offset, $eocd_commentsize) = unpack('VvvvvVVv', $eocd);
die("not a (commentless) zip archive\n") unless $eocd_magic == 0x06054b50 && $eocd_commentsize == 0;
if ($eocd_cdcnt == 0xffff || $eocd_tcdcnt == 0xffff || $cd_size == 0xffffffff || $cd_offset == 0xffffffff) {
my $eocd64l = readbytes($handle, 20, $zipsize - 42);
my ($eocd64l_magic, $eocd64l_cddisk, $eocd64_offset, $eocd64_offset_hi, $eocd64l_ndisk) = unpack('VVVVV', $eocd64l);
die("missing end of central directory locator\n") unless $eocd64l_magic == 0x07064b50;
quadit($eocd64_offset, $eocd64_offset_hi);
die("multidisc zip archive\n") unless $eocd64l_cddisk == 0;
die("invalid eocd64 offset\n") if $eocd64_offset > $zipsize - (20 + 22) || $zipsize - (20 + 22) - $eocd64_offset >= 0x10000 || $zipsize - (20 + 22) - $eocd64_offset < 56;
$eocd = readbytes($handle, 56, $eocd64_offset);
my ($eocd_cdcnt_hi, $eocd_tcdcnt_hi, $cd_offset_hi, $cd_size_hi);
($eocd_magic, undef, undef, undef, undef, $eocd_disk, $eocd_cddisk, $eocd_cdcnt, $eocd_cdcnt_hi, $eocd_tcdcnt, $eocd_tcdcnt_hi, $cd_size, $cd_size_hi, $cd_offset, $cd_offset_hi) = unpack('VVVvvVVVVVVVVVV');
die("missing zip64 end of central directory record\n") unless $eocd_magic == 0x06064b50;
quadit($eocd_cdcnt, $eocd_cdcnt_hi);
quadit($eocd_tcdcnt, $eocd_tcdcnt_hi);
quadit($cd_offset, $cd_offset_hi);
die("invalid cd offset\n") if $cd_offset >= $eocd64_offset;
die("central directory size mismatch\n") if $cd_size != $eocd64_offset - $cd_offset;
} else {
die("central directory size mismatch\n") if $cd_size != $zipsize - 22 - $cd_offset;
}
die("multidisc zip archive\n") unless $eocd_disk == 0 && $eocd_cddisk == 0;
die("central directory too big\n") if $cd_size >= 0x1000000;
my $left = $cd_size;
my @l;
while ($left > 0) {
die("bad directory entry\n") if $left < 46;
my $ent = readbytes($handle, 46, !@l ? $cd_offset : undef);
my ($ent_magic, $ent_vmade, $ent_vneed, $ent_bits, $ent_comp, $ent_time, $ent_date, $ent_crc, $ent_csize, $ent_size, $ent_fnsize, $ent_extrasize, $ent_commentsize, $ent_diskno, $ent_iattr, $ent_xattr, $ent_lhdr) = unpack('VvvvvvvVVVvvvvvVV', $ent);
die("bad directory entry\n") if $left < 46 + $ent_fnsize + $ent_extrasize + $ent_commentsize;
my $name = readbytes($handle, $ent_fnsize);
my $extra = readbytes($handle, $ent_extrasize);
my $comment = readbytes($handle, $ent_commentsize);
my $ziptype;
my $ent_system = $ent_vmade >> 8;
my $ent_mode;
if ($ent_system == 3) {
$ziptype = $ent_xattr >> 28;
$ent_mode = ($ent_xattr >> 16) & 07777;
} else {
$ziptype = 8;
$ziptype = 4 if $name =~ /\/$/;
$ent_mode = $ziptype == 8 ? 0644 : 0755;
$ent_mode &= 0555 if $ent_system == 0 && ($ent_xattr & 1) != 0;
}
$name =~ s/\/+$//;
$name =~ s/^\/+//;
$name = '.' if $name eq '';
push @l, { 'name' => $name, 'size' => $ent_size, 'csize' => $ent_csize, 'comp' => $ent_comp, 'lhdroffset' => $ent_lhdr , 'extra' => $extra, 'comment' => $comment, 'bits' => $ent_bits, 'ziptype' => $ziptype, 'mode' => $ent_mode, 'crc' => $ent_crc };
$left -= 46 + $ent_fnsize + $ent_extrasize + $ent_commentsize;
}
return \@l;
}
1;
07070100000020000041ed00000000000000000000000163e504b900000000000000000000000000000000000000000000000700000000PBuild07070100000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000b00000000TRAILER!!!
