mirror of
https://github.com/xcat2/xcat-core.git
synced 2026-10-21 15:18:19 +00:00
Vinícius Ferrão
fa233e6d36
Preserve source modes when staging Debian package builds and accept a private source fixture. Build group-writable profiles under umasks 0022 and 0002, then check the extracted data, postscripts and directories. Verify that staging and packaging leave source permissions unchanged, including a world-writable data file. Reuse the payload checks for normal, reduced and permission-regression builds.
202 lines
8.0 KiB
Perl
202 lines
8.0 KiB
Perl
package XCAT::Test::Lifecycle;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Capture::Tiny qw(capture);
|
|
use Cwd qw(getcwd);
|
|
use File::Basename qw(dirname basename);
|
|
use File::Copy qw(copy);
|
|
use File::Path qw(make_path);
|
|
use File::Slurper qw(read_binary write_binary);
|
|
use File::Temp qw(tempdir);
|
|
use Text::ParseWords qw(shellwords);
|
|
use XCAT::Test::File qw(repo_path);
|
|
|
|
sub command {
|
|
my (@argv) = @_;
|
|
my ($out, $err, $status) = capture { system(@argv) };
|
|
$status = $status == -1 ? 255 : ($status & 127) ? 128 + ($status & 127) : $status >> 8;
|
|
return ($status, $out, $err);
|
|
}
|
|
|
|
sub checked {
|
|
my (@argv) = @_;
|
|
my ($status, $out, $err) = command(@argv);
|
|
die "@argv failed ($status):\n$out$err" if $status;
|
|
return $out;
|
|
}
|
|
|
|
sub build_deb {
|
|
my ($package, $source) = @_;
|
|
$source //= repo_path('.');
|
|
my $work = tempdir(CLEANUP => 1);
|
|
checked('tar', '-cf', "$work/source.tar", '-C', $source, $package);
|
|
checked('tar', '-xpf', "$work/source.tar", '-C', $work);
|
|
my $previous = getcwd();
|
|
chdir "$work/$package" or die "chdir: $!";
|
|
local $ENV{PWD} = getcwd();
|
|
my ($status, $out, $err) = command('dpkg-buildpackage', '-b', '-uc', '-us', '-d');
|
|
chdir $previous or die "chdir: $!";
|
|
die "Building $package failed ($status):\n$out$err" if $status;
|
|
my @debs = glob "$work/*.deb";
|
|
die "Expected one $package DEB, found @debs" unless @debs == 1;
|
|
return $debs[0];
|
|
}
|
|
|
|
sub new {
|
|
my ($class) = @_;
|
|
my $root = tempdir(CLEANUP => 1);
|
|
my $self = bless {root => $root}, $class;
|
|
make_path(map { "$root/$_" } qw(etc opt var tmp run install root test-bin
|
|
usr/sbin usr/lib/systemd/system usr/share/doc proc dev
|
|
var/lib/dpkg/updates var/lib/dpkg/info var/lib/ucf var/cache/debconf
|
|
etc/init.d etc/profile.d etc/systemd/system etc/alternatives));
|
|
$self->write('/var/lib/dpkg/status', '');
|
|
$self->write('/etc/passwd', "root:x:0:0:root:/root:/bin/sh\nwww-data:x:33:33:www-data:/var/www:/usr/sbin/nologin\n");
|
|
$self->write('/etc/group', "root:x:0:\nwww-data:x:33:\n");
|
|
$self->write('/etc/profile.d/xcat.sh', "export XCATROOT=/opt/xcat\nexport PATH=/test-bin:/opt/xcat/sbin:/usr/sbin:/usr/bin:/sbin:/bin\n");
|
|
copy('/etc/ld.so.cache', "$root/etc/ld.so.cache") or die "copy ld.so.cache: $!" if -f '/etc/ld.so.cache';
|
|
copy('/etc/debconf.conf', "$root/etc/debconf.conf") or die "copy debconf.conf: $!" if -f '/etc/debconf.conf';
|
|
if (-f '/etc/debian_version') {
|
|
my @packages = qw(base-files ucf debconf systemd init-system-helpers);
|
|
$self->write('/var/lib/dpkg/status', checked('dpkg-query', '-s', @packages));
|
|
for my $record ((map { "/var/lib/dpkg/info/$_.list" } @packages), '/var/lib/dpkg/info/ucf.templates') {
|
|
copy($record, "$root/var/lib/dpkg/info/" . basename($record)) or die "copy $record: $!";
|
|
}
|
|
}
|
|
for my $dir ('', '/sbin', '/lib', '/lib/systemd', '/share') {
|
|
for my $entry (glob "/usr$dir/*") {
|
|
my $name = basename($entry);
|
|
next if $dir eq '/sbin' && $name eq 'init';
|
|
next if -d "$root/usr$dir/$name";
|
|
symlink("/host-usr$dir/$name", "$root/usr$dir/$name") or die "symlink: $!";
|
|
}
|
|
}
|
|
for my $entry (glob '/etc/alternatives/*') {
|
|
next unless -l $entry;
|
|
symlink(readlink($entry), "$root/etc/alternatives/" . basename($entry)) or die "symlink: $!";
|
|
}
|
|
for my $dir (qw(bin sbin lib lib64)) {
|
|
next unless -l "/$dir";
|
|
symlink(readlink("/$dir"), "$root/$dir") or die "symlink: $!";
|
|
}
|
|
$self->private_bin('/sbin') if -d '/sbin' && !-l '/sbin';
|
|
if (-f "$root/var/lib/dpkg/info/ucf.templates") {
|
|
my ($status, $out, $err) = $self->run('debconf-loadtemplate', 'ucf', '/var/lib/dpkg/info/ucf.templates');
|
|
die "Loading ucf templates failed: $out$err" if $status;
|
|
}
|
|
return $self;
|
|
}
|
|
|
|
sub path { return $_[0]->{root} . $_[1]; }
|
|
|
|
sub write {
|
|
my ($self, $path, $text, $mode) = @_;
|
|
my $destination = $self->path($path);
|
|
make_path(dirname($destination));
|
|
write_binary($destination, $text);
|
|
chmod($mode, $destination) == 1 or die "chmod $destination: $!" if defined $mode;
|
|
}
|
|
|
|
sub read { return read_binary($_[0]->path($_[1])); }
|
|
|
|
sub private_bin {
|
|
my ($self, $dir) = @_;
|
|
my $target = $self->path($dir);
|
|
unlink $target or die "unlink $target: $!" if -l $target;
|
|
make_path($target);
|
|
my $host = $dir =~ m{^/usr/} ? "/host-usr" . substr($dir, 4) : "/host" . $dir;
|
|
for my $entry (glob "$dir/*") {
|
|
my $name = basename($entry);
|
|
next if $name eq 'init';
|
|
next if -e "$target/$name" || -l "$target/$name";
|
|
symlink("$host/$name", "$target/$name") or die "symlink: $!";
|
|
}
|
|
}
|
|
|
|
sub hide_command {
|
|
my ($self, $name) = @_;
|
|
for my $dir (qw(/usr/bin /usr/sbin /bin /sbin)) {
|
|
next if -l $dir;
|
|
$self->private_bin($dir);
|
|
my $entry = $self->path("$dir/$name");
|
|
unlink $entry or die "unlink $entry: $!" if -e $entry || -l $entry;
|
|
}
|
|
}
|
|
|
|
sub start_unit {
|
|
my ($self, $path) = @_;
|
|
my ($section, @commands);
|
|
for my $line (split /\n/, $self->read($path)) {
|
|
if ($line =~ /^\s*\[([^]]+)\]\s*$/) { $section = $1; next; }
|
|
next unless ($section // '') eq 'Service' && $line =~ /^\s*ExecStart\s*=\s*(.*)$/;
|
|
my $value = $1;
|
|
if (length $value) { push @commands, $value; } else { @commands = (); }
|
|
}
|
|
die 'Expected one service start command' unless @commands == 1;
|
|
return $self->run(shellwords($commands[0]));
|
|
}
|
|
|
|
sub run {
|
|
my ($self, @argv) = @_;
|
|
my $root = $self->{root};
|
|
my $prefix = $self->{chroot} ? '/image' : '';
|
|
my @mounts;
|
|
if ($self->{chroot}) {
|
|
push @mounts, '--tmpfs', '/', '--ro-bind', '/usr', '/usr';
|
|
for my $dir (qw(bin sbin lib lib64)) {
|
|
next unless -e "/$dir";
|
|
push @mounts, -l "/$dir" ? ('--symlink', readlink("/$dir"), "/$dir")
|
|
: ('--ro-bind', "/$dir", "/$dir");
|
|
}
|
|
}
|
|
push @mounts, ('--bind', $root, "$prefix/", '--ro-bind', '/usr', "$prefix/host-usr",
|
|
'--ro-bind', repo_path('.'), "$prefix/source");
|
|
for my $dir (qw(bin sbin lib lib64)) {
|
|
next unless -e "/$dir";
|
|
next if -l "$root/$dir";
|
|
push @mounts, -l "/$dir" ? ('--symlink', readlink("/$dir"), "$prefix/$dir")
|
|
: ('--ro-bind', "/$dir", "$prefix/" . (-d "$root/$dir" ? "host/$dir" : $dir));
|
|
}
|
|
push @mounts, ('--ro-bind', $self->{deb}, "$prefix/package.deb") if $self->{deb};
|
|
push @mounts, ('--proc', "$prefix/proc") if $self->{live};
|
|
push @mounts, ('--cap-add', 'CAP_SYS_CHROOT') if $self->{chroot};
|
|
unshift @argv, 'chroot', $prefix if $self->{chroot};
|
|
return command('/usr/bin/env', '-i', 'PATH=/usr/bin:/bin',
|
|
'bwrap', '--die-with-parent', '--unshare-all', '--uid', $self->{uid} // 0,
|
|
'--gid', $self->{gid} // 0,
|
|
@mounts, '--dev', "$prefix/dev", '--setenv', 'PATH',
|
|
'/test-bin:/opt/xcat/sbin:/usr/sbin:/usr/bin:/sbin:/bin',
|
|
'--setenv', 'HOME', '/root', '--setenv', 'LC_ALL', 'C',
|
|
'--setenv', 'DEBIAN_FRONTEND', 'noninteractive', '--chdir', '/', @argv);
|
|
}
|
|
|
|
sub record_command {
|
|
my ($self, $path, $delegate) = @_;
|
|
my $name = basename($path);
|
|
my $forward = defined $delegate ? "exec \"$delegate\" \"\$@\"\n" : '';
|
|
$self->write($path, "#!/bin/sh\nprintf '$name' >> /calls\n" .
|
|
'for arg do printf " <%s>" "$arg" >> /calls; done' .
|
|
"\nprintf '\\n' >> /calls\n$forward", 0755);
|
|
}
|
|
|
|
sub install_deb {
|
|
my ($self, $deb) = @_;
|
|
local $self->{deb} = $deb;
|
|
return $self->run('dpkg', '--force-depends', '--force-confold', '-i', '/package.deb');
|
|
}
|
|
|
|
sub deb_script {
|
|
my ($self, $deb, $script, @args) = @_;
|
|
local $self->{deb} = $deb;
|
|
my @unpack = $self->run('dpkg-deb', '-e', '/package.deb', '/tmp/control');
|
|
return @unpack if $unpack[0];
|
|
my $package = checked('dpkg-deb', '-f', $deb, 'Package');
|
|
chomp $package;
|
|
return $self->run('env', "DPKG_MAINTSCRIPT_PACKAGE=$package",
|
|
"DPKG_MAINTSCRIPT_NAME=$script", 'DPKG_MAINTSCRIPT_ARCH=all',
|
|
'/bin/sh', "/tmp/control/$script", @args);
|
|
}
|
|
|
|
1;
|