mirror of
https://github.com/xcat2/xcat-core.git
synced 2026-09-04 20:17:55 +00:00
refactor(build): merge the two BuildUtils modules into one
The rebase onto master left the repository with two modules named BuildUtils.pm: the shared build helpers at the root, package BuildUtils, and the target architecture parser at build-utils/lib/XCAT/BuildUtils.pm, package XCAT::BuildUtils. buildrpms.pl loaded both, one through `@INC` and one through a path require. A reader cannot tell which module a BuildUtils reference names, and the test sandbox staged the wrong one. Move the shared helpers into build-utils/lib/XCAT/BuildUtils.pm as XCAT::BuildUtils, and export targetarch_from_target beside them. Both builders and the four tests now put build-utils/lib on `@INC` and import from the one module. targetarch_from_target keeps its behaviour: it returns the same architecture as before for suffixed targets, empty and undefined input, mixed case and every architecture token. Signed-off-by: Daniel Hilst <392820+dhilst@users.noreply.github.com>
This commit is contained in:
Daniel Hilst
-466
@@ -1,466 +0,0 @@
|
||||
package BuildUtils;
|
||||
# Reusable, unit-testable helpers shared by the xcat-core build tooling: buildrpms.pl
|
||||
# (rpm/mock) and builddebs.pl (deb/reprepro). Both derive the same Version-Release from
|
||||
# the same git state, stage the same xCAT-probe helpers, and shell out the same way, so
|
||||
# that logic lives here once instead of twice.
|
||||
#
|
||||
# Everything here is a pure function of its arguments, or a thin wrapper whose side
|
||||
# effect is the argument. Nothing reaches for an orchestrator global, so
|
||||
# xCAT-test/unit/build_utils.t drives every function directly rather than grepping the
|
||||
# builders for evidence that they call it.
|
||||
#
|
||||
# It mirrors xcat-dep's BuildUtils.pm in shape and intent; the two repos ship separate
|
||||
# copies because neither installs the other's tooling.
|
||||
use strict;
|
||||
use warnings;
|
||||
use Exporter 'import';
|
||||
use File::Copy qw(copy move);
|
||||
use File::Basename qw(basename);
|
||||
use File::Path qw(make_path remove_tree);
|
||||
use File::Slurper qw(read_text write_text);
|
||||
use POSIX qw(strftime);
|
||||
use Pod::Usage qw(pod2usage);
|
||||
use feature 'say';
|
||||
|
||||
our @EXPORT_OK = qw(
|
||||
source_date_epoch snap_release deb_version
|
||||
stage_probe_helpers XCAT_PROBE_HELPERS
|
||||
deb_package_arches dist_arches default_dists
|
||||
orig_tarball_name upstream_version resolve_dest
|
||||
pin_control_version rewrite_changelog_header
|
||||
reprepro_distributions reprepro_options
|
||||
lock_id_for take_build_lock
|
||||
sh_quote clean_debian_residue git_revision
|
||||
backup_file restore_file
|
||||
sh sh_or_die usage
|
||||
rewrite_file write_script read_line
|
||||
buildinfo_text
|
||||
);
|
||||
|
||||
# Both builders echo the commands they run under --verbose. Set once, after
|
||||
# option parsing, rather than threaded through every sh() call site.
|
||||
our $VERBOSE = 0;
|
||||
|
||||
# The xCAT-probe helpers. xcat-probe reuses functions shipped by xCAT; they are COPIED
|
||||
# rather than symlinked because a symlink does not survive packaging, and rather than
|
||||
# maintained twice because they would drift. Both builders stage them the same way.
|
||||
# The stamp both builders write beside a published repository. deploy.sh copies
|
||||
# the file verbatim and cluster-test.pl parses it, so the field names and their
|
||||
# order are a contract; each builder passes its own time format and writes to
|
||||
# its own filename, which are part of that contract too.
|
||||
sub buildinfo_text {
|
||||
my (%args) = @_;
|
||||
my $commit = $args{commit} // 'unknown';
|
||||
my $host = $args{host};
|
||||
unless (defined $host) {
|
||||
$host = `hostname 2>/dev/null` || 'unknown';
|
||||
chomp $host;
|
||||
}
|
||||
return join('', map { "$_\n" }
|
||||
"VERSION=$args{version}",
|
||||
"RELEASE=$args{release}",
|
||||
"BUILD_TIME=" . strftime($args{time_format}, gmtime($args{epoch})),
|
||||
"BUILD_MACHINE=$host",
|
||||
"COMMIT_ID=" . substr($commit, 0, 7),
|
||||
"COMMIT_ID_LONG=$commit");
|
||||
}
|
||||
|
||||
# Write a helper script and make it executable. Both builders ship a
|
||||
# mklocalrepo.sh beside the packages they publish, and builddebs.pl installs the
|
||||
# genesis postscripts the same way; a script written without the executable bit
|
||||
# is shipped broken, so the mode is not left to the caller to remember. It
|
||||
# still varies -- the published repo helper is group-writable, the postscripts
|
||||
# are not -- so the caller may say, and 0775 is only the default.
|
||||
sub write_script {
|
||||
my ($path, $content, $mode) = @_;
|
||||
$mode = 0775 unless defined $mode;
|
||||
write_text($path, $content);
|
||||
chmod $mode, $path or die "Cannot chmod $path: $!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
# The first line of a file, without its newline. Version and Release are
|
||||
# one-line stamps that both builders read, and each spelled the open, the read
|
||||
# and the chomp differently -- buildrpms.pl chomped ten lines away from its
|
||||
# read, which is how a stamp keeps a trailing newline nobody notices until it
|
||||
# lands in a package name. Returns undef when the file is absent, which is
|
||||
# what a caller with a fallback wants.
|
||||
sub read_line {
|
||||
my ($path) = @_;
|
||||
return undef unless -f $path;
|
||||
my ($line) = split /\n/, read_text($path), 2;
|
||||
return undef unless defined $line && length $line;
|
||||
return $line;
|
||||
}
|
||||
|
||||
# Read a file, pass its contents through $transform, write the result back.
|
||||
# A file that is not there is left alone, which is what every caller wanted.
|
||||
sub rewrite_file {
|
||||
my ($path, $transform) = @_;
|
||||
return 0 unless -f $path;
|
||||
write_text($path, $transform->(read_text($path)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Run a shell command, returning its EXIT STATUS. system() yields the raw wait
|
||||
# status, which is the exit code times 256, so it is shifted here: a caller
|
||||
# comparing the result against a specific code gets the code it expects, not a
|
||||
# multiple of it.
|
||||
sub sh {
|
||||
my ($cmd) = @_;
|
||||
say "Running: $cmd" if $VERBOSE;
|
||||
system($cmd);
|
||||
return $? >> 8;
|
||||
}
|
||||
|
||||
# pod2usage reads the POD of the running program, so each builder keeps its own
|
||||
# help text while sharing the way it is printed and the status it exits with.
|
||||
# Run a command and stop the build when it fails. The same operation was
|
||||
# spelled in opposite polarities -- `sh(...) == 0 or die` in builddebs.pl,
|
||||
# `sh(...) and die` in buildrpms.pl, which also used both -- and the `and die`
|
||||
# form reads as though the die is what happens next rather than what happens on
|
||||
# failure. One name, one direction, and the exit code lands in the message.
|
||||
sub sh_or_die {
|
||||
my ($cmd, $message) = @_;
|
||||
my $rc = sh($cmd);
|
||||
return 0 if $rc == 0;
|
||||
$message = "FATAL: command failed: $cmd" unless defined $message;
|
||||
$message =~ s/\n\z//;
|
||||
die "$message (exit $rc)\n";
|
||||
}
|
||||
|
||||
sub usage {
|
||||
my (%args) = @_;
|
||||
pod2usage(
|
||||
-verbose => $args{verbose} // 1,
|
||||
-exitval => $args{exitval} // 2,
|
||||
(defined($args{message}) && length($args{message})
|
||||
? (-message => "$args{message}\n") : ()),
|
||||
);
|
||||
}
|
||||
|
||||
use constant XCAT_PROBE_HELPERS => qw(
|
||||
GlobalDef.pm
|
||||
NetworkUtils.pm
|
||||
ServiceNodeUtils.pm
|
||||
);
|
||||
|
||||
# Packages whose .deb carries a real architecture. Everything else in xcat-core is
|
||||
# Perl and ships as Architecture: all -- one binary serving every Ubuntu release and
|
||||
# every arch, which is why this build never needs a per-codename chroot.
|
||||
my %ARCH_PACKAGES = map { $_ => 1 } qw(xCAT xCATsn xCAT-genesis-scripts);
|
||||
|
||||
# Ubuntu releases predating ppc64el. Kept as data rather than an `if` in the caller so
|
||||
# the repo-assembly and the package-selection paths cannot disagree about it.
|
||||
my %NO_PPC64EL = map { $_ => 1 } qw(saucy);
|
||||
|
||||
my @DEB_ARCHES = qw(amd64 ppc64el);
|
||||
|
||||
# The Ubuntu releases the apt repository serves by default. Single source of truth:
|
||||
# the builder, the repo assembly and the tests all read it here, so they cannot drift.
|
||||
my @DEFAULT_DISTS = qw(focal jammy noble resolute);
|
||||
|
||||
sub default_dists { return @DEFAULT_DISTS; }
|
||||
|
||||
# sh_quote: single-quote a string for safe use in a shell command.
|
||||
# clean_debian_residue: remove what dpkg-buildpackage leaves inside a package's
|
||||
# debian/ directory.
|
||||
#
|
||||
# debian/files accumulates one line per artifact and is never truncated by
|
||||
# `dh_clean -d`, which only removes directories. dpkg-genchanges then reads the
|
||||
# stale entries on the next build and fstats artifacts that are no longer there:
|
||||
# dpkg-genchanges: error: cannot fstat file ../perl-xcat_<old release>_amd64.buildinfo
|
||||
# so a second build in the same checkout dies as soon as the release string moves.
|
||||
# The staging directories go for the same reason the old shell builder removed
|
||||
# them -- they are the previous build's payload, not source.
|
||||
#
|
||||
# Call this only after a package's LAST architecture: debian/files carries the
|
||||
# amd64 artifacts that the ppc64el run's dpkg-genchanges still needs.
|
||||
# backup_file / restore_file: put a file back exactly as it was.
|
||||
#
|
||||
# File::Copy::copy does NOT carry permissions, so a naive backup-and-restore returns
|
||||
# an executable with its exec bit stripped -- the content compares equal and only
|
||||
# `git diff` notices the mode change. xCAT/postscripts/{bmcsetup,getipmi} are shipped
|
||||
# executable and are rewritten during the xCAT build, so this is not hypothetical.
|
||||
# git_revision: the commit the packages are built from.
|
||||
#
|
||||
# This is not cosmetic. perl-xCAT/debian/rules and perl-xCAT.spec both pass it to
|
||||
# modifyUtils, which substitutes it and the version into xCAT::Version. Hand
|
||||
# modifyUtils an empty string and it does nothing, and the built package reports no
|
||||
# version at all -- `lsxcatd -v` prints a bare "Version". So a revision is always
|
||||
# produced: the git checkout when there is one, an existing Gitinfo when there is
|
||||
# not (a source export carries the real revision that way, and clobbering it with
|
||||
# a placeholder would throw away the only provenance the tree has), and only then
|
||||
# the "unknown" placeholder.
|
||||
sub git_revision {
|
||||
my (%args) = @_;
|
||||
my $run = $args{git} || sub { `git rev-parse HEAD 2>/dev/null` };
|
||||
my $read_file = $args{read_file} || sub {
|
||||
return unless -f 'Gitinfo';
|
||||
return scalar read_text('Gitinfo');
|
||||
};
|
||||
|
||||
for my $source ($run, $read_file) {
|
||||
my $rev = $source->();
|
||||
next unless defined $rev;
|
||||
$rev =~ s/\s+\z//;
|
||||
return $rev if length $rev;
|
||||
}
|
||||
return 'unknown';
|
||||
}
|
||||
|
||||
sub backup_file {
|
||||
my ($path) = @_;
|
||||
return unless defined $path && -f $path;
|
||||
my $backup = "$path.build.save";
|
||||
my $mode = ( stat $path )[2] & 07777;
|
||||
copy( $path, $backup ) or die "Cannot back up $path: $!\n";
|
||||
return [ $backup, $path, $mode ];
|
||||
}
|
||||
|
||||
sub restore_file {
|
||||
my ($entry) = @_;
|
||||
return 0 unless $entry;
|
||||
my ( $backup, $path, $mode ) = @{$entry};
|
||||
move( $backup, $path ) or do { warn "Could not restore $path: $!\n"; return 0; };
|
||||
chmod $mode, $path if defined $mode;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub clean_debian_residue {
|
||||
my ($package_root) = @_;
|
||||
return () unless defined $package_root && -d "$package_root/debian";
|
||||
|
||||
my @removed;
|
||||
my $files = "$package_root/debian/files";
|
||||
if (-e $files) {
|
||||
unlink $files or die "Cannot remove $files: $!\n";
|
||||
push @removed, $files;
|
||||
}
|
||||
|
||||
my $stem = lc(basename($package_root));
|
||||
foreach my $dir (glob("$package_root/debian/$stem*")) {
|
||||
next unless -d $dir;
|
||||
remove_tree($dir);
|
||||
push @removed, $dir;
|
||||
}
|
||||
|
||||
# debhelper's own bookkeeping. Never tracked, and it accumulates per build.
|
||||
# glob returns a wildcard-free pattern verbatim whether or not it exists, so
|
||||
# the -e guard is what makes a second call a no-op rather than a fatal unlink.
|
||||
foreach my $residue (glob("$package_root/debian/*.debhelper.log"),
|
||||
"$package_root/debian/.debhelper") {
|
||||
next unless -e $residue;
|
||||
if (-d $residue) { remove_tree($residue); }
|
||||
else { unlink $residue or die "Cannot remove $residue: $!\n"; }
|
||||
push @removed, $residue;
|
||||
}
|
||||
|
||||
return @removed;
|
||||
}
|
||||
|
||||
sub sh_quote {
|
||||
my ($s) = @_;
|
||||
$s = '' if !defined $s;
|
||||
$s =~ s/'/'"'"'/g;
|
||||
return "'$s'";
|
||||
}
|
||||
|
||||
# source_date_epoch: the commit time the build is reproducible against.
|
||||
#
|
||||
# Gitepoch wins when present -- CI writes it so every arch of one release stamps an
|
||||
# identical epoch even when the arches build minutes apart. Falling back to the local
|
||||
# clock is last-resort: it makes the build non-reproducible, so the caller is told.
|
||||
sub source_date_epoch {
|
||||
my (%args) = @_;
|
||||
my $read = $args{read_file} || sub {
|
||||
my ($p) = @_;
|
||||
return unless -f $p;
|
||||
return scalar read_text($p);
|
||||
};
|
||||
my $git = $args{git_epoch} || sub { return scalar `git log -1 --format=%ct HEAD 2>/dev/null`; };
|
||||
|
||||
for my $candidate ($read->('Gitepoch'), $git->()) {
|
||||
next unless defined $candidate;
|
||||
chomp $candidate;
|
||||
return $candidate if $candidate =~ /\A\d+\z/;
|
||||
}
|
||||
return $args{now} || time();
|
||||
}
|
||||
|
||||
# snap_release: the Release string, derived from the commit time so identical sources
|
||||
# give identical NVRs. UTC, because a build host's timezone must not change the name.
|
||||
sub snap_release {
|
||||
my ($epoch) = @_;
|
||||
return strftime("snap%Y%m%d%H%M", gmtime($epoch));
|
||||
}
|
||||
|
||||
# deb_version: the Debian version. Same Version-Release pair the rpms carry, so an
|
||||
# apt repo and a yum repo built from one commit report the same thing.
|
||||
sub deb_version {
|
||||
my ($version, $release) = @_;
|
||||
return "$version-$release";
|
||||
}
|
||||
|
||||
# stage_probe_helpers: copy the shared helpers into xCAT-probe's tree.
|
||||
# Returns the list of destination paths, so a caller can remove exactly what it added.
|
||||
sub stage_probe_helpers {
|
||||
my ($source_dir, $dest_dir) = @_;
|
||||
make_path($dest_dir) unless -d $dest_dir;
|
||||
my @staged;
|
||||
for my $helper (XCAT_PROBE_HELPERS) {
|
||||
my $from = "$source_dir/$helper";
|
||||
my $to = "$dest_dir/$helper";
|
||||
copy($from, $to) or die "Unable to stage $from into $dest_dir: $!\n";
|
||||
push @staged, $to;
|
||||
}
|
||||
return @staged;
|
||||
}
|
||||
|
||||
# deb_package_arches: the architectures to build a package for.
|
||||
# 'all' is a single arch-independent build; the three arch packages get one per arch.
|
||||
sub deb_package_arches {
|
||||
my ($package) = @_;
|
||||
return @DEB_ARCHES if $ARCH_PACKAGES{$package // ''};
|
||||
return ('all');
|
||||
}
|
||||
|
||||
# dist_arches: the architectures a release's apt repo declares.
|
||||
sub dist_arches {
|
||||
my ($dist) = @_;
|
||||
return ('amd64') if $NO_PPC64EL{$dist // ''};
|
||||
return @DEB_ARCHES;
|
||||
}
|
||||
|
||||
# orig_tarball_name: the .orig.tar.gz dpkg-source expects for a 3.0 (quilt) package.
|
||||
#
|
||||
# The name carries the UPSTREAM version only -- dpkg looks for
|
||||
# <source>_<upstream>.orig.tar.gz, with no Debian revision, because one upstream
|
||||
# tarball is shared by every revision built from it. The revision is stripped here
|
||||
# rather than at the call site so passing the full Version-Release cannot produce a
|
||||
# tarball dpkg will not find. Lower-cased because dpkg requires a lower-case source
|
||||
# package name.
|
||||
sub upstream_version {
|
||||
my ($version) = @_;
|
||||
return '' unless defined $version;
|
||||
$version =~ s/-[^-]*\z//; # drop the Debian revision, if any
|
||||
return $version;
|
||||
}
|
||||
|
||||
sub orig_tarball_name {
|
||||
my ($package, $version) = @_;
|
||||
return lc($package) . '_' . upstream_version($version) . '.orig.tar.gz';
|
||||
}
|
||||
|
||||
# resolve_dest: turn a --dest argument into an absolute path.
|
||||
#
|
||||
# NOT Cwd::abs_path: that returns undef when a PARENT component is missing, and the
|
||||
# caller then interpolates undef, so `--dest /no/such/parent/out` silently becomes
|
||||
# `/debs` and `/xcat-core` at the filesystem root. rel2abs is purely lexical and
|
||||
# works for a path that does not exist yet, which is the normal case for an output
|
||||
# directory.
|
||||
sub resolve_dest {
|
||||
my ($dest, $default) = @_;
|
||||
return $default unless defined $dest && length $dest;
|
||||
require File::Spec;
|
||||
return File::Spec->rel2abs($dest);
|
||||
}
|
||||
|
||||
# pin_control_version: pin xCAT's inter-package dependencies to this exact build.
|
||||
#
|
||||
# debian/control carries the sentinel ">= 2.13-snap000000000000" on every intra-xCAT
|
||||
# dependency. Left alone, apt would satisfy them with any older xCAT already installed,
|
||||
# so a partial upgrade could mix versions. Replacing it with "= <version>" makes the set
|
||||
# install or fail as a unit.
|
||||
sub pin_control_version {
|
||||
my ($control, $version) = @_;
|
||||
return $control unless defined $control;
|
||||
$control =~ s/>= \Q2.13-snap000000000000\E/= $version/g;
|
||||
return $control;
|
||||
}
|
||||
|
||||
# rewrite_changelog_header: set the version and the trailer date of the top stanza.
|
||||
#
|
||||
# The date comes from SOURCE_DATE_EPOCH rather than "now" so two builds of one commit
|
||||
# produce byte-identical packages. Only the first stanza is touched -- the history below
|
||||
# it is not ours to rewrite.
|
||||
sub rewrite_changelog_header {
|
||||
my ($changelog, $version, $date, $maintainer) = @_;
|
||||
return $changelog unless defined $changelog;
|
||||
$changelog =~ s/\A(\S+) \([^)]*\)/$1 ($version)/;
|
||||
$changelog =~ s/^ -- .*$/ -- $maintainer $date/m;
|
||||
return $changelog;
|
||||
}
|
||||
|
||||
# reprepro_distributions: the conf/distributions body for the whole repo.
|
||||
#
|
||||
# One stanza per release, all listing the same packages: xcat-core debs are Perl and are
|
||||
# byte-identical across releases, so the build produces them once and every codename
|
||||
# serves the same files. keyid is undef for an unsigned repo.
|
||||
sub reprepro_distributions {
|
||||
my ($dists, $keyid) = @_;
|
||||
my $out = '';
|
||||
for my $dist (@$dists) {
|
||||
my $arches = join ' ', dist_arches($dist);
|
||||
$out .= <<"STANZA";
|
||||
Origin: xCAT internal repository
|
||||
Label: xcat-core bazaar repository
|
||||
Codename: $dist
|
||||
Architectures: $arches
|
||||
Components: main
|
||||
Description: Repository automatically genereted conf
|
||||
STANZA
|
||||
$out .= "SignWith: $keyid\n" if defined $keyid && length $keyid;
|
||||
$out .= "\n";
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
# reprepro_options: the conf/options body.
|
||||
#
|
||||
# ask-passphrase is omitted when a GNUPGHOME is supplied, because that key is
|
||||
# passphrase-less and an unattended build must never stop to prompt.
|
||||
sub reprepro_options {
|
||||
my ($gpg_home) = @_;
|
||||
my $out = "verbose\n";
|
||||
$out .= "ask-passphrase\n" unless defined $gpg_home && length $gpg_home;
|
||||
$out .= "basedir .\n";
|
||||
return $out;
|
||||
}
|
||||
|
||||
|
||||
# lock_id_for: a short, stable id for a checkout path.
|
||||
#
|
||||
# The build rewrites debian/changelog and debian/control and runs dpkg-buildpackage
|
||||
# inside the package directories, so what two builds contend for is the CHECKOUT, not
|
||||
# the host. A host-global lock made the devel and stable CD lanes collide even though
|
||||
# they share nothing. Keying on the path lets distinct checkouts build in parallel while
|
||||
# two builds of one checkout still fail fast.
|
||||
sub lock_id_for {
|
||||
my ($path) = @_;
|
||||
require Digest::MD5;
|
||||
return substr(Digest::MD5::md5_hex(defined $path ? $path : ''), 0, 12);
|
||||
}
|
||||
|
||||
# lock_path_for: where that checkout's lock lives.
|
||||
# Local /var/lock deliberately: the checkout itself may be on NFS, where flock is not
|
||||
# reliable.
|
||||
sub lock_path_for {
|
||||
my ($path, $dir) = @_;
|
||||
$dir = '/var/lock' unless defined $dir;
|
||||
return "$dir/xcatbld-" . lock_id_for($path) . ".lock";
|
||||
}
|
||||
|
||||
# take_build_lock: take the checkout's lock, or die.
|
||||
# Returns the open handle -- the lock is held for as long as the caller keeps it.
|
||||
sub take_build_lock {
|
||||
my ($path, $dir) = @_;
|
||||
require Fcntl;
|
||||
my $lockfile = lock_path_for($path, $dir);
|
||||
open my $fh, '>', $lockfile or die "FATAL: cannot open $lockfile: $!\n";
|
||||
flock($fh, Fcntl::LOCK_EX() | Fcntl::LOCK_NB())
|
||||
or die "FATAL: another build of $path already holds $lockfile\n";
|
||||
return $fh;
|
||||
}
|
||||
|
||||
1;
|
||||
@@ -1,12 +1,472 @@
|
||||
package XCAT::BuildUtils;
|
||||
|
||||
# Reusable, unit-testable helpers shared by the xcat-core build tooling: buildrpms.pl
|
||||
# (rpm/mock) and builddebs.pl (deb/reprepro). Both derive the same Version-Release from
|
||||
# the same git state, stage the same xCAT-probe helpers, and shell out the same way, so
|
||||
# that logic lives here once instead of twice.
|
||||
#
|
||||
# Everything here is a pure function of its arguments, or a thin wrapper whose side
|
||||
# effect is the argument. Nothing reaches for an orchestrator global, so
|
||||
# xCAT-test/unit/build_utils.t drives every function directly rather than grepping the
|
||||
# builders for evidence that they call it.
|
||||
#
|
||||
# It mirrors xcat-dep's BuildUtils.pm in shape and intent; the two repos ship separate
|
||||
# copies because neither installs the other's tooling.
|
||||
use strict;
|
||||
use warnings;
|
||||
use Exporter 'import';
|
||||
use File::Copy qw(copy move);
|
||||
use File::Basename qw(basename);
|
||||
use File::Path qw(make_path remove_tree);
|
||||
use File::Slurper qw(read_text write_text);
|
||||
use POSIX qw(strftime);
|
||||
use Pod::Usage qw(pod2usage);
|
||||
use feature 'say';
|
||||
|
||||
use Exporter qw(import);
|
||||
our @EXPORT_OK = qw(
|
||||
source_date_epoch snap_release deb_version
|
||||
stage_probe_helpers XCAT_PROBE_HELPERS
|
||||
deb_package_arches dist_arches default_dists
|
||||
orig_tarball_name upstream_version resolve_dest
|
||||
pin_control_version rewrite_changelog_header
|
||||
reprepro_distributions reprepro_options
|
||||
lock_id_for take_build_lock
|
||||
sh_quote clean_debian_residue git_revision
|
||||
backup_file restore_file
|
||||
sh sh_or_die usage
|
||||
rewrite_file write_script read_line
|
||||
buildinfo_text
|
||||
targetarch_from_target
|
||||
);
|
||||
|
||||
our @EXPORT_OK = qw(targetarch_from_target);
|
||||
# Both builders echo the commands they run under --verbose. Set once, after
|
||||
# option parsing, rather than threaded through every sh() call site.
|
||||
our $VERBOSE = 0;
|
||||
|
||||
# The xCAT-probe helpers. xcat-probe reuses functions shipped by xCAT; they are COPIED
|
||||
# rather than symlinked because a symlink does not survive packaging, and rather than
|
||||
# maintained twice because they would drift. Both builders stage them the same way.
|
||||
# The stamp both builders write beside a published repository. deploy.sh copies
|
||||
# the file verbatim and cluster-test.pl parses it, so the field names and their
|
||||
# order are a contract; each builder passes its own time format and writes to
|
||||
# its own filename, which are part of that contract too.
|
||||
sub buildinfo_text {
|
||||
my (%args) = @_;
|
||||
my $commit = $args{commit} // 'unknown';
|
||||
my $host = $args{host};
|
||||
unless (defined $host) {
|
||||
$host = `hostname 2>/dev/null` || 'unknown';
|
||||
chomp $host;
|
||||
}
|
||||
return join('', map { "$_\n" }
|
||||
"VERSION=$args{version}",
|
||||
"RELEASE=$args{release}",
|
||||
"BUILD_TIME=" . strftime($args{time_format}, gmtime($args{epoch})),
|
||||
"BUILD_MACHINE=$host",
|
||||
"COMMIT_ID=" . substr($commit, 0, 7),
|
||||
"COMMIT_ID_LONG=$commit");
|
||||
}
|
||||
|
||||
# Write a helper script and make it executable. Both builders ship a
|
||||
# mklocalrepo.sh beside the packages they publish, and builddebs.pl installs the
|
||||
# genesis postscripts the same way; a script written without the executable bit
|
||||
# is shipped broken, so the mode is not left to the caller to remember. It
|
||||
# still varies -- the published repo helper is group-writable, the postscripts
|
||||
# are not -- so the caller may say, and 0775 is only the default.
|
||||
sub write_script {
|
||||
my ($path, $content, $mode) = @_;
|
||||
$mode = 0775 unless defined $mode;
|
||||
write_text($path, $content);
|
||||
chmod $mode, $path or die "Cannot chmod $path: $!\n";
|
||||
return;
|
||||
}
|
||||
|
||||
# The first line of a file, without its newline. Version and Release are
|
||||
# one-line stamps that both builders read, and each spelled the open, the read
|
||||
# and the chomp differently -- buildrpms.pl chomped ten lines away from its
|
||||
# read, which is how a stamp keeps a trailing newline nobody notices until it
|
||||
# lands in a package name. Returns undef when the file is absent, which is
|
||||
# what a caller with a fallback wants.
|
||||
sub read_line {
|
||||
my ($path) = @_;
|
||||
return undef unless -f $path;
|
||||
my ($line) = split /\n/, read_text($path), 2;
|
||||
return undef unless defined $line && length $line;
|
||||
return $line;
|
||||
}
|
||||
|
||||
# Read a file, pass its contents through $transform, write the result back.
|
||||
# A file that is not there is left alone, which is what every caller wanted.
|
||||
sub rewrite_file {
|
||||
my ($path, $transform) = @_;
|
||||
return 0 unless -f $path;
|
||||
write_text($path, $transform->(read_text($path)));
|
||||
return 1;
|
||||
}
|
||||
|
||||
# Run a shell command, returning its EXIT STATUS. system() yields the raw wait
|
||||
# status, which is the exit code times 256, so it is shifted here: a caller
|
||||
# comparing the result against a specific code gets the code it expects, not a
|
||||
# multiple of it.
|
||||
sub sh {
|
||||
my ($cmd) = @_;
|
||||
say "Running: $cmd" if $VERBOSE;
|
||||
system($cmd);
|
||||
return $? >> 8;
|
||||
}
|
||||
|
||||
# pod2usage reads the POD of the running program, so each builder keeps its own
|
||||
# help text while sharing the way it is printed and the status it exits with.
|
||||
# Run a command and stop the build when it fails. The same operation was
|
||||
# spelled in opposite polarities -- `sh(...) == 0 or die` in builddebs.pl,
|
||||
# `sh(...) and die` in buildrpms.pl, which also used both -- and the `and die`
|
||||
# form reads as though the die is what happens next rather than what happens on
|
||||
# failure. One name, one direction, and the exit code lands in the message.
|
||||
sub sh_or_die {
|
||||
my ($cmd, $message) = @_;
|
||||
my $rc = sh($cmd);
|
||||
return 0 if $rc == 0;
|
||||
$message = "FATAL: command failed: $cmd" unless defined $message;
|
||||
$message =~ s/\n\z//;
|
||||
die "$message (exit $rc)\n";
|
||||
}
|
||||
|
||||
sub usage {
|
||||
my (%args) = @_;
|
||||
pod2usage(
|
||||
-verbose => $args{verbose} // 1,
|
||||
-exitval => $args{exitval} // 2,
|
||||
(defined($args{message}) && length($args{message})
|
||||
? (-message => "$args{message}\n") : ()),
|
||||
);
|
||||
}
|
||||
|
||||
use constant XCAT_PROBE_HELPERS => qw(
|
||||
GlobalDef.pm
|
||||
NetworkUtils.pm
|
||||
ServiceNodeUtils.pm
|
||||
);
|
||||
|
||||
# Packages whose .deb carries a real architecture. Everything else in xcat-core is
|
||||
# Perl and ships as Architecture: all -- one binary serving every Ubuntu release and
|
||||
# every arch, which is why this build never needs a per-codename chroot.
|
||||
my %ARCH_PACKAGES = map { $_ => 1 } qw(xCAT xCATsn xCAT-genesis-scripts);
|
||||
|
||||
# Ubuntu releases predating ppc64el. Kept as data rather than an `if` in the caller so
|
||||
# the repo-assembly and the package-selection paths cannot disagree about it.
|
||||
my %NO_PPC64EL = map { $_ => 1 } qw(saucy);
|
||||
|
||||
my @DEB_ARCHES = qw(amd64 ppc64el);
|
||||
|
||||
# The Ubuntu releases the apt repository serves by default. Single source of truth:
|
||||
# the builder, the repo assembly and the tests all read it here, so they cannot drift.
|
||||
my @DEFAULT_DISTS = qw(focal jammy noble resolute);
|
||||
|
||||
sub default_dists { return @DEFAULT_DISTS; }
|
||||
|
||||
# sh_quote: single-quote a string for safe use in a shell command.
|
||||
# clean_debian_residue: remove what dpkg-buildpackage leaves inside a package's
|
||||
# debian/ directory.
|
||||
#
|
||||
# debian/files accumulates one line per artifact and is never truncated by
|
||||
# `dh_clean -d`, which only removes directories. dpkg-genchanges then reads the
|
||||
# stale entries on the next build and fstats artifacts that are no longer there:
|
||||
# dpkg-genchanges: error: cannot fstat file ../perl-xcat_<old release>_amd64.buildinfo
|
||||
# so a second build in the same checkout dies as soon as the release string moves.
|
||||
# The staging directories go for the same reason the old shell builder removed
|
||||
# them -- they are the previous build's payload, not source.
|
||||
#
|
||||
# Call this only after a package's LAST architecture: debian/files carries the
|
||||
# amd64 artifacts that the ppc64el run's dpkg-genchanges still needs.
|
||||
# backup_file / restore_file: put a file back exactly as it was.
|
||||
#
|
||||
# File::Copy::copy does NOT carry permissions, so a naive backup-and-restore returns
|
||||
# an executable with its exec bit stripped -- the content compares equal and only
|
||||
# `git diff` notices the mode change. xCAT/postscripts/{bmcsetup,getipmi} are shipped
|
||||
# executable and are rewritten during the xCAT build, so this is not hypothetical.
|
||||
# git_revision: the commit the packages are built from.
|
||||
#
|
||||
# This is not cosmetic. perl-xCAT/debian/rules and perl-xCAT.spec both pass it to
|
||||
# modifyUtils, which substitutes it and the version into xCAT::Version. Hand
|
||||
# modifyUtils an empty string and it does nothing, and the built package reports no
|
||||
# version at all -- `lsxcatd -v` prints a bare "Version". So a revision is always
|
||||
# produced: the git checkout when there is one, an existing Gitinfo when there is
|
||||
# not (a source export carries the real revision that way, and clobbering it with
|
||||
# a placeholder would throw away the only provenance the tree has), and only then
|
||||
# the "unknown" placeholder.
|
||||
sub git_revision {
|
||||
my (%args) = @_;
|
||||
my $run = $args{git} || sub { `git rev-parse HEAD 2>/dev/null` };
|
||||
my $read_file = $args{read_file} || sub {
|
||||
return unless -f 'Gitinfo';
|
||||
return scalar read_text('Gitinfo');
|
||||
};
|
||||
|
||||
for my $source ($run, $read_file) {
|
||||
my $rev = $source->();
|
||||
next unless defined $rev;
|
||||
$rev =~ s/\s+\z//;
|
||||
return $rev if length $rev;
|
||||
}
|
||||
return 'unknown';
|
||||
}
|
||||
|
||||
sub backup_file {
|
||||
my ($path) = @_;
|
||||
return unless defined $path && -f $path;
|
||||
my $backup = "$path.build.save";
|
||||
my $mode = ( stat $path )[2] & 07777;
|
||||
copy( $path, $backup ) or die "Cannot back up $path: $!\n";
|
||||
return [ $backup, $path, $mode ];
|
||||
}
|
||||
|
||||
sub restore_file {
|
||||
my ($entry) = @_;
|
||||
return 0 unless $entry;
|
||||
my ( $backup, $path, $mode ) = @{$entry};
|
||||
move( $backup, $path ) or do { warn "Could not restore $path: $!\n"; return 0; };
|
||||
chmod $mode, $path if defined $mode;
|
||||
return 1;
|
||||
}
|
||||
|
||||
sub clean_debian_residue {
|
||||
my ($package_root) = @_;
|
||||
return () unless defined $package_root && -d "$package_root/debian";
|
||||
|
||||
my @removed;
|
||||
my $files = "$package_root/debian/files";
|
||||
if (-e $files) {
|
||||
unlink $files or die "Cannot remove $files: $!\n";
|
||||
push @removed, $files;
|
||||
}
|
||||
|
||||
my $stem = lc(basename($package_root));
|
||||
foreach my $dir (glob("$package_root/debian/$stem*")) {
|
||||
next unless -d $dir;
|
||||
remove_tree($dir);
|
||||
push @removed, $dir;
|
||||
}
|
||||
|
||||
# debhelper's own bookkeeping. Never tracked, and it accumulates per build.
|
||||
# glob returns a wildcard-free pattern verbatim whether or not it exists, so
|
||||
# the -e guard is what makes a second call a no-op rather than a fatal unlink.
|
||||
foreach my $residue (glob("$package_root/debian/*.debhelper.log"),
|
||||
"$package_root/debian/.debhelper") {
|
||||
next unless -e $residue;
|
||||
if (-d $residue) { remove_tree($residue); }
|
||||
else { unlink $residue or die "Cannot remove $residue: $!\n"; }
|
||||
push @removed, $residue;
|
||||
}
|
||||
|
||||
return @removed;
|
||||
}
|
||||
|
||||
sub sh_quote {
|
||||
my ($s) = @_;
|
||||
$s = '' if !defined $s;
|
||||
$s =~ s/'/'"'"'/g;
|
||||
return "'$s'";
|
||||
}
|
||||
|
||||
# source_date_epoch: the commit time the build is reproducible against.
|
||||
#
|
||||
# Gitepoch wins when present -- CI writes it so every arch of one release stamps an
|
||||
# identical epoch even when the arches build minutes apart. Falling back to the local
|
||||
# clock is last-resort: it makes the build non-reproducible, so the caller is told.
|
||||
sub source_date_epoch {
|
||||
my (%args) = @_;
|
||||
my $read = $args{read_file} || sub {
|
||||
my ($p) = @_;
|
||||
return unless -f $p;
|
||||
return scalar read_text($p);
|
||||
};
|
||||
my $git = $args{git_epoch} || sub { return scalar `git log -1 --format=%ct HEAD 2>/dev/null`; };
|
||||
|
||||
for my $candidate ($read->('Gitepoch'), $git->()) {
|
||||
next unless defined $candidate;
|
||||
chomp $candidate;
|
||||
return $candidate if $candidate =~ /\A\d+\z/;
|
||||
}
|
||||
return $args{now} || time();
|
||||
}
|
||||
|
||||
# snap_release: the Release string, derived from the commit time so identical sources
|
||||
# give identical NVRs. UTC, because a build host's timezone must not change the name.
|
||||
sub snap_release {
|
||||
my ($epoch) = @_;
|
||||
return strftime("snap%Y%m%d%H%M", gmtime($epoch));
|
||||
}
|
||||
|
||||
# deb_version: the Debian version. Same Version-Release pair the rpms carry, so an
|
||||
# apt repo and a yum repo built from one commit report the same thing.
|
||||
sub deb_version {
|
||||
my ($version, $release) = @_;
|
||||
return "$version-$release";
|
||||
}
|
||||
|
||||
# stage_probe_helpers: copy the shared helpers into xCAT-probe's tree.
|
||||
# Returns the list of destination paths, so a caller can remove exactly what it added.
|
||||
sub stage_probe_helpers {
|
||||
my ($source_dir, $dest_dir) = @_;
|
||||
make_path($dest_dir) unless -d $dest_dir;
|
||||
my @staged;
|
||||
for my $helper (XCAT_PROBE_HELPERS) {
|
||||
my $from = "$source_dir/$helper";
|
||||
my $to = "$dest_dir/$helper";
|
||||
copy($from, $to) or die "Unable to stage $from into $dest_dir: $!\n";
|
||||
push @staged, $to;
|
||||
}
|
||||
return @staged;
|
||||
}
|
||||
|
||||
# deb_package_arches: the architectures to build a package for.
|
||||
# 'all' is a single arch-independent build; the three arch packages get one per arch.
|
||||
sub deb_package_arches {
|
||||
my ($package) = @_;
|
||||
return @DEB_ARCHES if $ARCH_PACKAGES{$package // ''};
|
||||
return ('all');
|
||||
}
|
||||
|
||||
# dist_arches: the architectures a release's apt repo declares.
|
||||
sub dist_arches {
|
||||
my ($dist) = @_;
|
||||
return ('amd64') if $NO_PPC64EL{$dist // ''};
|
||||
return @DEB_ARCHES;
|
||||
}
|
||||
|
||||
# orig_tarball_name: the .orig.tar.gz dpkg-source expects for a 3.0 (quilt) package.
|
||||
#
|
||||
# The name carries the UPSTREAM version only -- dpkg looks for
|
||||
# <source>_<upstream>.orig.tar.gz, with no Debian revision, because one upstream
|
||||
# tarball is shared by every revision built from it. The revision is stripped here
|
||||
# rather than at the call site so passing the full Version-Release cannot produce a
|
||||
# tarball dpkg will not find. Lower-cased because dpkg requires a lower-case source
|
||||
# package name.
|
||||
sub upstream_version {
|
||||
my ($version) = @_;
|
||||
return '' unless defined $version;
|
||||
$version =~ s/-[^-]*\z//; # drop the Debian revision, if any
|
||||
return $version;
|
||||
}
|
||||
|
||||
sub orig_tarball_name {
|
||||
my ($package, $version) = @_;
|
||||
return lc($package) . '_' . upstream_version($version) . '.orig.tar.gz';
|
||||
}
|
||||
|
||||
# resolve_dest: turn a --dest argument into an absolute path.
|
||||
#
|
||||
# NOT Cwd::abs_path: that returns undef when a PARENT component is missing, and the
|
||||
# caller then interpolates undef, so `--dest /no/such/parent/out` silently becomes
|
||||
# `/debs` and `/xcat-core` at the filesystem root. rel2abs is purely lexical and
|
||||
# works for a path that does not exist yet, which is the normal case for an output
|
||||
# directory.
|
||||
sub resolve_dest {
|
||||
my ($dest, $default) = @_;
|
||||
return $default unless defined $dest && length $dest;
|
||||
require File::Spec;
|
||||
return File::Spec->rel2abs($dest);
|
||||
}
|
||||
|
||||
# pin_control_version: pin xCAT's inter-package dependencies to this exact build.
|
||||
#
|
||||
# debian/control carries the sentinel ">= 2.13-snap000000000000" on every intra-xCAT
|
||||
# dependency. Left alone, apt would satisfy them with any older xCAT already installed,
|
||||
# so a partial upgrade could mix versions. Replacing it with "= <version>" makes the set
|
||||
# install or fail as a unit.
|
||||
sub pin_control_version {
|
||||
my ($control, $version) = @_;
|
||||
return $control unless defined $control;
|
||||
$control =~ s/>= \Q2.13-snap000000000000\E/= $version/g;
|
||||
return $control;
|
||||
}
|
||||
|
||||
# rewrite_changelog_header: set the version and the trailer date of the top stanza.
|
||||
#
|
||||
# The date comes from SOURCE_DATE_EPOCH rather than "now" so two builds of one commit
|
||||
# produce byte-identical packages. Only the first stanza is touched -- the history below
|
||||
# it is not ours to rewrite.
|
||||
sub rewrite_changelog_header {
|
||||
my ($changelog, $version, $date, $maintainer) = @_;
|
||||
return $changelog unless defined $changelog;
|
||||
$changelog =~ s/\A(\S+) \([^)]*\)/$1 ($version)/;
|
||||
$changelog =~ s/^ -- .*$/ -- $maintainer $date/m;
|
||||
return $changelog;
|
||||
}
|
||||
|
||||
# reprepro_distributions: the conf/distributions body for the whole repo.
|
||||
#
|
||||
# One stanza per release, all listing the same packages: xcat-core debs are Perl and are
|
||||
# byte-identical across releases, so the build produces them once and every codename
|
||||
# serves the same files. keyid is undef for an unsigned repo.
|
||||
sub reprepro_distributions {
|
||||
my ($dists, $keyid) = @_;
|
||||
my $out = '';
|
||||
for my $dist (@$dists) {
|
||||
my $arches = join ' ', dist_arches($dist);
|
||||
$out .= <<"STANZA";
|
||||
Origin: xCAT internal repository
|
||||
Label: xcat-core bazaar repository
|
||||
Codename: $dist
|
||||
Architectures: $arches
|
||||
Components: main
|
||||
Description: Repository automatically genereted conf
|
||||
STANZA
|
||||
$out .= "SignWith: $keyid\n" if defined $keyid && length $keyid;
|
||||
$out .= "\n";
|
||||
}
|
||||
return $out;
|
||||
}
|
||||
|
||||
# reprepro_options: the conf/options body.
|
||||
#
|
||||
# ask-passphrase is omitted when a GNUPGHOME is supplied, because that key is
|
||||
# passphrase-less and an unattended build must never stop to prompt.
|
||||
sub reprepro_options {
|
||||
my ($gpg_home) = @_;
|
||||
my $out = "verbose\n";
|
||||
$out .= "ask-passphrase\n" unless defined $gpg_home && length $gpg_home;
|
||||
$out .= "basedir .\n";
|
||||
return $out;
|
||||
}
|
||||
|
||||
|
||||
# lock_id_for: a short, stable id for a checkout path.
|
||||
#
|
||||
# The build rewrites debian/changelog and debian/control and runs dpkg-buildpackage
|
||||
# inside the package directories, so what two builds contend for is the CHECKOUT, not
|
||||
# the host. A host-global lock made the devel and stable CD lanes collide even though
|
||||
# they share nothing. Keying on the path lets distinct checkouts build in parallel while
|
||||
# two builds of one checkout still fail fast.
|
||||
sub lock_id_for {
|
||||
my ($path) = @_;
|
||||
require Digest::MD5;
|
||||
return substr(Digest::MD5::md5_hex(defined $path ? $path : ''), 0, 12);
|
||||
}
|
||||
|
||||
# lock_path_for: where that checkout's lock lives.
|
||||
# Local /var/lock deliberately: the checkout itself may be on NFS, where flock is not
|
||||
# reliable.
|
||||
sub lock_path_for {
|
||||
my ($path, $dir) = @_;
|
||||
$dir = '/var/lock' unless defined $dir;
|
||||
return "$dir/xcatbld-" . lock_id_for($path) . ".lock";
|
||||
}
|
||||
|
||||
# take_build_lock: take the checkout's lock, or die.
|
||||
# Returns the open handle -- the lock is held for as long as the caller keeps it.
|
||||
sub take_build_lock {
|
||||
my ($path, $dir) = @_;
|
||||
require Fcntl;
|
||||
my $lockfile = lock_path_for($path, $dir);
|
||||
open my $fh, '>', $lockfile or die "FATAL: cannot open $lockfile: $!\n";
|
||||
flock($fh, Fcntl::LOCK_EX() | Fcntl::LOCK_NB())
|
||||
or die "FATAL: another build of $path already holds $lockfile\n";
|
||||
return $fh;
|
||||
}
|
||||
|
||||
# The rpm architecture a mock target builds for. A target carries the arch as its
|
||||
# last meaningful token (alma+epel-10-ppc64le), and a suffixed target keeps it in
|
||||
# the middle (rocky-10-riscv64-xcat), so the token is found from the right.
|
||||
sub targetarch_from_target {
|
||||
my ( $target, $default_arch ) = @_;
|
||||
return $default_arch unless defined($target) && length($target);
|
||||
|
||||
+6
-6
@@ -3,7 +3,7 @@
|
||||
#
|
||||
# Replaces build-ubunturepo. The shape mirrors buildrpms.pl -- Getopt::Long options,
|
||||
# one package list, build then index then sign -- so the two builders read the same way
|
||||
# and share BuildUtils.pm.
|
||||
# and share XCAT::BuildUtils.
|
||||
#
|
||||
# The central fact this design rests on: xcat-core debs are Perl. They are byte-identical
|
||||
# for every Ubuntu release, so they are built ONCE and the same files are published into
|
||||
@@ -27,8 +27,8 @@ use POSIX qw(strftime);
|
||||
use Pod::Usage qw(pod2usage);
|
||||
|
||||
use FindBin;
|
||||
use lib $FindBin::Bin;
|
||||
use BuildUtils qw(
|
||||
use lib "$FindBin::Bin/build-utils/lib";
|
||||
use XCAT::BuildUtils qw(
|
||||
source_date_epoch snap_release deb_version
|
||||
stage_probe_helpers XCAT_PROBE_HELPERS
|
||||
deb_package_arches dist_arches default_dists
|
||||
@@ -57,7 +57,7 @@ my @PACKAGES = qw(
|
||||
);
|
||||
|
||||
# Releases the repo serves. The same debs are published into each; the list itself
|
||||
# lives in BuildUtils so the builder and the tests cannot disagree about it.
|
||||
# lives in XCAT::BuildUtils so the builder and the tests cannot disagree about it.
|
||||
my @DISTS = default_dists();
|
||||
|
||||
my %opts;
|
||||
@@ -77,7 +77,7 @@ GetOptions(
|
||||
) or usage();
|
||||
usage(exitval => 0, verbose => 2) if $opts{help};
|
||||
|
||||
$BuildUtils::VERBOSE = $opts{verbose};
|
||||
$XCAT::BuildUtils::VERBOSE = $opts{verbose};
|
||||
|
||||
$opts{packages} = @cli_packages ? \@cli_packages : \@PACKAGES;
|
||||
$opts{dists} = @cli_dists ? \@cli_dists : \@DISTS;
|
||||
@@ -126,7 +126,7 @@ $ENV{DEBEMAIL} = 'xcat-build@xcat.org';
|
||||
my $MAINTAINER = "$ENV{DEBFULLNAME} <$ENV{DEBEMAIL}>";
|
||||
my $DEB_DATE = strftime('%a, %d %b %Y %H:%M:%S +0000', gmtime($EPOCH));
|
||||
|
||||
# The build lock is scoped to this checkout, not the host -- see BuildUtils::lock_id_for.
|
||||
# The build lock is scoped to this checkout, not the host -- see XCAT::BuildUtils::lock_id_for.
|
||||
|
||||
# ------------------------------------------------------------------ staging --
|
||||
#
|
||||
|
||||
+6
-7
@@ -42,9 +42,9 @@ use File::Path qw(make_path remove_tree);
|
||||
use File::Slurper qw(read_text write_text);
|
||||
use File::Temp qw(tempdir tempfile);
|
||||
use FindBin qw($Bin);
|
||||
use lib $Bin;
|
||||
use BuildUtils qw(git_revision source_date_epoch sh sh_or_die usage buildinfo_text
|
||||
write_script read_line);
|
||||
use lib "$Bin/build-utils/lib";
|
||||
use XCAT::BuildUtils qw(git_revision source_date_epoch sh sh_or_die usage buildinfo_text
|
||||
write_script read_line targetarch_from_target);
|
||||
use Fcntl qw(:flock); # per-target build lock (concurrency guard; see main())
|
||||
use Getopt::Long qw(GetOptions);
|
||||
use POSIX qw(strftime);
|
||||
@@ -54,7 +54,6 @@ use Pod::Usage qw(pod2usage);
|
||||
use autodie;
|
||||
use autodie qw(cp);
|
||||
|
||||
require "$Bin/build-utils/lib/XCAT/BuildUtils.pm";
|
||||
|
||||
my $SOURCES = "$ENV{HOME}/rpmbuild/SOURCES";
|
||||
# Ensure the rpmbuild tree exists. buildrpms stages source tarballs into $SOURCES, but it only
|
||||
@@ -189,7 +188,7 @@ GetOptions(
|
||||
"source-only" => \$opts{source_only},
|
||||
) or usage();
|
||||
|
||||
$BuildUtils::VERBOSE = $opts{verbose};
|
||||
$XCAT::BuildUtils::VERBOSE = $opts{verbose};
|
||||
|
||||
# --package REPLACES the default set (build exactly what was asked), so
|
||||
# `--package xCAT-genesis-base` builds only genesis-base for the dep pipeline.
|
||||
@@ -435,7 +434,7 @@ sub buildspkgs {
|
||||
my $ext = $opts{mock_uniqueext} ? "-$opts{mock_uniqueext}" : "";
|
||||
my $chroot = "$pkg-$target$ext";
|
||||
my $targetarch =
|
||||
XCAT::BuildUtils::targetarch_from_target( $target, $ARCH );
|
||||
targetarch_from_target( $target, $ARCH );
|
||||
my $genesis_tarch = genesis_tarch_from_targetarch($targetarch);
|
||||
|
||||
my $diskcache = (
|
||||
@@ -492,7 +491,7 @@ sub buildpkgs {
|
||||
|
||||
# get x86_64 from alma+epel-9-x86_64
|
||||
my $targetarch =
|
||||
XCAT::BuildUtils::targetarch_from_target( $target, $ARCH );
|
||||
targetarch_from_target( $target, $ARCH );
|
||||
|
||||
# xCAT genesis packages include the translated target arch in their file names.
|
||||
my $arch = is_in($pkg, @NATIVE_PACKAGES) ? $targetarch : "noarch";
|
||||
|
||||
@@ -62,7 +62,7 @@ compiled output. That is why this build needs no ``sbuild`` and no per-codename
|
||||
chroot -- unlike xcat-deps, whose packages are compiled and genuinely differ per
|
||||
release.
|
||||
|
||||
Helpers shared by both builders live in ``BuildUtils.pm``.
|
||||
Helpers shared by both builders live in ``build-utils/lib/XCAT/BuildUtils.pm``.
|
||||
|
||||
``buildcore.sh`` builds the architecture specific packages (``xCAT``, ``xCATsn``,
|
||||
``xCAT-genesis-scripts``) for every supported architecture, riscv64 included, with
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
#!/usr/bin/env perl
|
||||
# BuildUtils.pm: the helpers buildrpms.pl and builddebs.pl share.
|
||||
# XCAT::BuildUtils: the helpers buildrpms.pl and builddebs.pl share.
|
||||
#
|
||||
# Every function here is pure, so every assertion below RUNS it. Nothing in this file
|
||||
# reads the builders' source to check that they call it -- that would pass with the
|
||||
@@ -13,12 +13,12 @@ use File::Spec;
|
||||
use File::Temp qw(tempdir);
|
||||
use FindBin;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use lib "$FindBin::Bin/../..";
|
||||
use lib "$FindBin::Bin/../../build-utils/lib";
|
||||
use Test::More;
|
||||
|
||||
BEGIN { use_ok('BuildUtils') or BAIL_OUT('BuildUtils.pm does not load'); }
|
||||
BEGIN { use_ok('XCAT::BuildUtils') or BAIL_OUT('XCAT::BuildUtils does not load'); }
|
||||
|
||||
use BuildUtils qw(
|
||||
use XCAT::BuildUtils qw(
|
||||
source_date_epoch snap_release deb_version
|
||||
stage_probe_helpers XCAT_PROBE_HELPERS
|
||||
deb_package_arches dist_arches
|
||||
@@ -312,7 +312,7 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
# deploy.sh copies this file verbatim and cluster-test.pl parses it, so the
|
||||
# field names and their order are a contract, not a presentation choice.
|
||||
{
|
||||
my $text = BuildUtils::buildinfo_text(
|
||||
my $text = XCAT::BuildUtils::buildinfo_text(
|
||||
version => '2.18.1', release => 'snap1', epoch => 0,
|
||||
commit => 'abcdef1234567890', host => 'builder',
|
||||
time_format => '%Y-%m-%d',
|
||||
@@ -328,8 +328,8 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
# The two builders stamp different formats, and both are consumed.
|
||||
my %common = (version => '1', release => '2', epoch => 0,
|
||||
commit => 'c', host => 'h');
|
||||
isnt( BuildUtils::buildinfo_text(%common, time_format => '%a %b %d %H:%M:%S %Y'),
|
||||
BuildUtils::buildinfo_text(%common, time_format => '%a %b %e %H:%M:%S %Z %Y'),
|
||||
isnt( XCAT::BuildUtils::buildinfo_text(%common, time_format => '%a %b %d %H:%M:%S %Y'),
|
||||
XCAT::BuildUtils::buildinfo_text(%common, time_format => '%a %b %e %H:%M:%S %Z %Y'),
|
||||
'each builder keeps the format its own consumers parse' );
|
||||
}
|
||||
|
||||
@@ -341,12 +341,12 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
my $path = File::Spec->catfile($dir, 'thing.txt');
|
||||
write_text($path, "one\ntwo\n");
|
||||
|
||||
my $changed = BuildUtils::rewrite_file($path, sub { uc $_[0] });
|
||||
my $changed = XCAT::BuildUtils::rewrite_file($path, sub { uc $_[0] });
|
||||
is( $changed, 1, 'rewriting a file that exists reports that it did' );
|
||||
is( read_text($path), "ONE\nTWO\n", 'and applies the transform' );
|
||||
|
||||
my $absent = File::Spec->catfile($dir, 'not-there.txt');
|
||||
is( BuildUtils::rewrite_file($absent, sub { die 'must not run' }), 0,
|
||||
is( XCAT::BuildUtils::rewrite_file($absent, sub { die 'must not run' }), 0,
|
||||
'a file that is not there is left alone, not created' );
|
||||
ok( !-e $absent, 'and really is not created' );
|
||||
}
|
||||
@@ -360,24 +360,24 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
my $path = File::Spec->catfile($dir, 'Version');
|
||||
|
||||
write_text($path, "2.18.1\n");
|
||||
is( BuildUtils::read_line($path), '2.18.1',
|
||||
is( XCAT::BuildUtils::read_line($path), '2.18.1',
|
||||
'a one-line stamp comes back without its newline' );
|
||||
|
||||
write_text($path, "2.18.1\nignored\n");
|
||||
is( BuildUtils::read_line($path), '2.18.1',
|
||||
is( XCAT::BuildUtils::read_line($path), '2.18.1',
|
||||
'and only the first line is taken' );
|
||||
|
||||
write_text($path, "2.18.1");
|
||||
is( BuildUtils::read_line($path), '2.18.1',
|
||||
is( XCAT::BuildUtils::read_line($path), '2.18.1',
|
||||
'a file with no trailing newline reads the same' );
|
||||
|
||||
# builddebs.pl falls back to snap_release() when there is no Release file,
|
||||
# so absence has to be reported rather than raised.
|
||||
is( BuildUtils::read_line(File::Spec->catfile($dir, 'nope')), undef,
|
||||
is( XCAT::BuildUtils::read_line(File::Spec->catfile($dir, 'nope')), undef,
|
||||
'a file that is not there reads as undef, not an error' );
|
||||
|
||||
write_text($path, "");
|
||||
is( BuildUtils::read_line($path), undef, 'and so does an empty file' );
|
||||
is( XCAT::BuildUtils::read_line($path), undef, 'and so does an empty file' );
|
||||
}
|
||||
|
||||
# ------------------------------------------------- the published helper script --
|
||||
@@ -389,7 +389,7 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
my $dir = tempdir(CLEANUP => 1);
|
||||
my $path = File::Spec->catfile($dir, 'mklocalrepo.sh');
|
||||
|
||||
BuildUtils::write_script($path, "#!/bin/sh\necho hello\n");
|
||||
XCAT::BuildUtils::write_script($path, "#!/bin/sh\necho hello\n");
|
||||
is( read_text($path), "#!/bin/sh\necho hello\n",
|
||||
'a helper script keeps the exact text it was given' );
|
||||
ok( -x $path, 'and is executable, which is the point of writing it this way' );
|
||||
@@ -399,7 +399,7 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
# The genesis postscripts builddebs.pl installs are 0755, not 0775, so the
|
||||
# mode has to stay the caller's to choose.
|
||||
my $ps = File::Spec->catfile($dir, 'bmcsetup');
|
||||
BuildUtils::write_script($ps, "#!/bin/sh\n", 0755);
|
||||
XCAT::BuildUtils::write_script($ps, "#!/bin/sh\n", 0755);
|
||||
is( (stat $ps)[2] & 07777, 0755, 'a caller may ask for a different mode' );
|
||||
}
|
||||
|
||||
@@ -408,20 +408,20 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
# two builders disagreed about shifting it, so a caller comparing sh() against
|
||||
# a specific code got the code from one and a multiple of it from the other.
|
||||
{
|
||||
is( BuildUtils::sh('true'), 0, 'a command that succeeds reports 0' );
|
||||
is( BuildUtils::sh('sh -c "exit 3"'), 3,
|
||||
is( XCAT::BuildUtils::sh('true'), 0, 'a command that succeeds reports 0' );
|
||||
is( XCAT::BuildUtils::sh('sh -c "exit 3"'), 3,
|
||||
'the exit code is returned, not the wait status it is packed into' );
|
||||
isnt( BuildUtils::sh('sh -c "exit 3"'), 768,
|
||||
isnt( XCAT::BuildUtils::sh('sh -c "exit 3"'), 768,
|
||||
'and specifically not the exit code times 256' );
|
||||
}
|
||||
|
||||
{
|
||||
# --verbose echoes the command; the default does not.
|
||||
local $BuildUtils::VERBOSE = 1;
|
||||
local $XCAT::BuildUtils::VERBOSE = 1;
|
||||
my $out = '';
|
||||
open my $fh, '>', \$out or die;
|
||||
my $old = select $fh;
|
||||
BuildUtils::sh('true');
|
||||
XCAT::BuildUtils::sh('true');
|
||||
select $old;
|
||||
close $fh;
|
||||
like( $out, qr/\ARunning: true/, 'a verbose run echoes the command' );
|
||||
@@ -433,16 +433,16 @@ isnt( git_revision( git => sub { '' }, read_file => sub { '' } ), '',
|
||||
# Reversed polarities for one operation are easy to misread, so there is now a
|
||||
# single name with a single direction.
|
||||
{
|
||||
is( BuildUtils::sh_or_die('true'), 0,
|
||||
is( XCAT::BuildUtils::sh_or_die('true'), 0,
|
||||
'a command that succeeds returns 0 and does not die' );
|
||||
|
||||
my $err = eval { BuildUtils::sh_or_die('sh -c "exit 4"', 'FATAL: it failed'); 1 }
|
||||
my $err = eval { XCAT::BuildUtils::sh_or_die('sh -c "exit 4"', 'FATAL: it failed'); 1 }
|
||||
? '' : $@;
|
||||
like( $err, qr/FATAL: it failed/, 'a failure dies with the caller\'s message' );
|
||||
like( $err, qr/exit 4/,
|
||||
'and names the exit code, which the old spellings threw away' );
|
||||
|
||||
my $bare = eval { BuildUtils::sh_or_die('sh -c "exit 5"'); 1 } ? '' : $@;
|
||||
my $bare = eval { XCAT::BuildUtils::sh_or_die('sh -c "exit 5"'); 1 } ? '' : $@;
|
||||
like( $bare, qr/\Qsh -c "exit 5"\E/,
|
||||
'a caller with no message still gets the command that failed' );
|
||||
}
|
||||
|
||||
@@ -16,10 +16,10 @@ use warnings;
|
||||
use File::Temp qw(tempdir);
|
||||
use FindBin;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use lib "$FindBin::Bin/../..";
|
||||
use lib "$FindBin::Bin/../../build-utils/lib";
|
||||
use Test::More;
|
||||
|
||||
use BuildUtils qw(lock_id_for take_build_lock);
|
||||
use XCAT::BuildUtils qw(lock_id_for take_build_lock);
|
||||
|
||||
my $lockdir = tempdir(CLEANUP => 1);
|
||||
|
||||
|
||||
@@ -142,12 +142,11 @@ ok( !grep( { $_ eq 'buildpkgs' } @{ stages_for(1) } ),
|
||||
# buildrpms.pl rewrites the tracked Gitinfo in its working directory and creates
|
||||
# $HOME/rpmbuild. Running it in place left the developer's tree dirty and reached
|
||||
# into their home for a test that only exercises argument parsing. Version is
|
||||
# staged because the same file-scope code reads it and dies without it. Both
|
||||
# modules named BuildUtils.pm are staged at their own relative paths, because
|
||||
# buildrpms.pl loads each from a different directory: BuildUtils.pm from its own,
|
||||
# and XCAT::BuildUtils from build-utils/lib/XCAT.
|
||||
# staged because the same file-scope code reads it and dies without it, and
|
||||
# XCAT::BuildUtils at its own relative path because buildrpms.pl puts
|
||||
# build-utils/lib on @INC relative to its own directory.
|
||||
my $sandbox = tempdir(CLEANUP => 1);
|
||||
for my $needed (qw(buildrpms.pl Version BuildUtils.pm
|
||||
for my $needed (qw(buildrpms.pl Version
|
||||
build-utils/lib/XCAT/BuildUtils.pm)) {
|
||||
my $from = repo_path($needed);
|
||||
BAIL_OUT("$needed is missing from the repository") unless -r $from;
|
||||
|
||||
@@ -9,8 +9,8 @@ use Test::More;
|
||||
use lib "$FindBin::Bin/../../xCAT-server/lib/perl";
|
||||
use lib "$FindBin::Bin/../../perl-xCAT";
|
||||
|
||||
use lib "$FindBin::Bin/../..";
|
||||
use BuildUtils ();
|
||||
use lib "$FindBin::Bin/../../build-utils/lib";
|
||||
use XCAT::BuildUtils ();
|
||||
|
||||
my $repo_root = File::Spec->catdir( $FindBin::Bin, '..', '..' );
|
||||
|
||||
@@ -155,13 +155,13 @@ close($rel_fh);
|
||||
ok( xCAT::Template::ubuntu_subiquity_local_apt_repo($repo_dir),
|
||||
'an indexed directory is' );
|
||||
|
||||
# The releases the deb builder serves by default. Read from BuildUtils, which is where
|
||||
# The releases the deb builder serves by default. Read from XCAT::BuildUtils, which is where
|
||||
# the builder itself reads them, rather than matched against the source that sets them:
|
||||
# the old assertion passed on any file containing that shell fragment, and broke on a
|
||||
# reflow that changed nothing.
|
||||
ok( scalar( grep { $_ eq 'resolute' } BuildUtils::default_dists() ),
|
||||
ok( scalar( grep { $_ eq 'resolute' } XCAT::BuildUtils::default_dists() ),
|
||||
'the Ubuntu repository serves resolute by default' );
|
||||
like( BuildUtils::reprepro_distributions( [ BuildUtils::default_dists() ], undef ),
|
||||
like( XCAT::BuildUtils::reprepro_distributions( [ XCAT::BuildUtils::default_dists() ], undef ),
|
||||
qr/^Codename: resolute$/m,
|
||||
'and a resolute stanza reaches conf/distributions' );
|
||||
|
||||
|
||||
Reference in New Issue
Block a user