mirror of
https://github.com/xcat2/xcat-core.git
synced 2026-09-01 15:06:04 +00:00
test: centralize repository file reads
This commit is contained in:
Vinícius Ferrão
@@ -0,0 +1,73 @@
|
||||
package XCAT::Test::File;
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Cwd qw(abs_path);
|
||||
use Exporter qw(import);
|
||||
use File::Basename qw(dirname);
|
||||
use File::Spec;
|
||||
use IO::Handle;
|
||||
|
||||
our @EXPORT_OK = qw(repo_path slurp_repo_file);
|
||||
|
||||
my $module_dir = dirname( File::Spec->rel2abs(__FILE__) );
|
||||
my $repo_root = abs_path(
|
||||
File::Spec->catdir(
|
||||
$module_dir,
|
||||
File::Spec->updir(),
|
||||
File::Spec->updir(),
|
||||
File::Spec->updir(),
|
||||
File::Spec->updir(),
|
||||
)
|
||||
);
|
||||
die "Unable to resolve the repository root from $module_dir: $!" unless defined $repo_root;
|
||||
my $module_path = File::Spec->catfile( $repo_root, 'xCAT-test', 'lib', 'XCAT', 'Test', 'File.pm' );
|
||||
die "Unable to locate the repository test support at $module_path" unless -f $module_path;
|
||||
|
||||
sub repo_path {
|
||||
my ($relative) = @_;
|
||||
die "Repository-relative path is required" unless defined $relative && length $relative;
|
||||
die "Repository path must be relative: $relative" if File::Spec->file_name_is_absolute($relative);
|
||||
foreach my $part ( File::Spec->splitdir($relative) ) {
|
||||
die "Repository path must not escape the checkout: $relative" if $part eq File::Spec->updir();
|
||||
}
|
||||
|
||||
return File::Spec->catfile( $repo_root, $relative );
|
||||
}
|
||||
|
||||
sub slurp_repo_file {
|
||||
my ($relative) = @_;
|
||||
my $path = repo_path($relative);
|
||||
|
||||
open( my $fh, '<:raw', $path ) or die "Unable to open $path for reading: $!";
|
||||
my $contents = do { local $/; <$fh> };
|
||||
unless ( defined $contents && !$fh->error ) {
|
||||
my $error = $!;
|
||||
close($fh);
|
||||
die "Unable to read $path: $error";
|
||||
}
|
||||
close($fh) or die "Unable to close $path: $!";
|
||||
|
||||
return $contents;
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=head1 NAME
|
||||
|
||||
XCAT::Test::File - repository file helpers for source-tree tests
|
||||
|
||||
=head1 FUNCTIONS
|
||||
|
||||
=head2 repo_path
|
||||
|
||||
Returns the absolute path for a repository-relative path.
|
||||
|
||||
=head2 slurp_repo_file
|
||||
|
||||
Reads a repository-relative file in raw mode and returns its complete contents.
|
||||
|
||||
=cut
|
||||
@@ -3,27 +3,16 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use File::Spec;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
|
||||
my $repo_root = File::Spec->catdir( $FindBin::Bin, '..', '..' );
|
||||
use XCAT::Test::File qw(repo_path slurp_repo_file);
|
||||
|
||||
sub read_file {
|
||||
my ($file) = @_;
|
||||
my $path = File::Spec->catfile( $repo_root, $file );
|
||||
|
||||
open( my $fh, '<', $path ) or die "Unable to read $path: $!";
|
||||
my $contents = do { local $/; <$fh> };
|
||||
close($fh);
|
||||
|
||||
return $contents;
|
||||
}
|
||||
|
||||
my $spec = read_file('xCAT-server/xCAT-server.spec');
|
||||
my $spec = slurp_repo_file('xCAT-server/xCAT-server.spec');
|
||||
unlike( $spec, qr/\bdnf\s+download\b/, 'xCAT-server RPM scripts do not download packages' );
|
||||
unlike( $spec, qr{/install/dhcp_pkgs}, 'xCAT-server RPM scripts do not write hidden DHCP package directories' );
|
||||
|
||||
my $anaconda = read_file('xCAT-server/lib/xcat/plugins/anaconda.pm');
|
||||
my $anaconda = slurp_repo_file('xCAT-server/lib/xcat/plugins/anaconda.pm');
|
||||
unlike( $anaconda, qr{/install/dhcp_pkgs}, 'copycds does not inject hidden DHCP package directories into pkgdir' );
|
||||
|
||||
my @pkglist_files = qw(
|
||||
@@ -37,12 +26,12 @@ my %el10_pkglist_aliases = (
|
||||
);
|
||||
|
||||
foreach my $file ( sort keys %el10_pkglist_aliases ) {
|
||||
my $path = File::Spec->catfile( $repo_root, $file );
|
||||
my $path = repo_path($file);
|
||||
is( readlink($path), $el10_pkglist_aliases{$file}, "$file uses the EL10 package list" );
|
||||
}
|
||||
|
||||
foreach my $file (@pkglist_files) {
|
||||
my $path = File::Spec->catfile( $repo_root, $file );
|
||||
my $path = repo_path($file);
|
||||
open( my $fh, '<', $path ) or die "Unable to read $path: $!";
|
||||
|
||||
my @packages;
|
||||
|
||||
@@ -3,23 +3,12 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use File::Spec;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
|
||||
my $repo_root = File::Spec->catdir( $FindBin::Bin, '..', '..' );
|
||||
use XCAT::Test::File qw(slurp_repo_file);
|
||||
|
||||
sub read_file {
|
||||
my ($file) = @_;
|
||||
my $path = File::Spec->catfile( $repo_root, $file );
|
||||
|
||||
open( my $fh, '<', $path ) or die "Unable to read $path: $!";
|
||||
my $contents = do { local $/; <$fh> };
|
||||
close($fh);
|
||||
|
||||
return $contents;
|
||||
}
|
||||
|
||||
my $genimage = read_file('xCAT-server/share/xcat/netboot/rh/genimage');
|
||||
my $genimage = slurp_repo_file('xCAT-server/share/xcat/netboot/rh/genimage');
|
||||
|
||||
like( $genimage, qr/sub el_major_version/, 'RH genimage has an EL major-version helper' );
|
||||
like( $genimage, qr/sub rpm_installroot_command/, 'RH genimage builds RPM installroot commands through one helper' );
|
||||
|
||||
@@ -0,0 +1,83 @@
|
||||
#!/usr/bin/env perl
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Cwd qw(abs_path getcwd);
|
||||
use File::Spec;
|
||||
use FindBin;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
|
||||
use XCAT::Test::File qw(repo_path slurp_repo_file);
|
||||
|
||||
my $readme_relative = File::Spec->catfile( 'xCAT-test', 'unit', 'README.md' );
|
||||
my $expected_root = abs_path( File::Spec->catdir( $FindBin::Bin, File::Spec->updir(), File::Spec->updir() ) );
|
||||
my $readme_path = repo_path($readme_relative);
|
||||
ok( File::Spec->file_name_is_absolute($readme_path), 'repo_path returns an absolute path' );
|
||||
is( $readme_path, File::Spec->catfile( $expected_root, $readme_relative ), 'repo_path resolves from the checkout root' );
|
||||
|
||||
my $readme = slurp_repo_file($readme_relative);
|
||||
like( $readme, qr/^# xCAT-test\/unit\n.*\n.*source tree/s, 'multiline text contents are preserved' );
|
||||
|
||||
is( slurp_repo_file('xCAT-genesis-builder/cmdlist_check'), '', 'empty file contents are preserved' );
|
||||
|
||||
my $favicon = slurp_repo_file('xCAT-UI/images/favicon.ico');
|
||||
is( length($favicon), 5686, 'binary file length is preserved' );
|
||||
is( substr( $favicon, 0, 8 ), "\x00\x00\x01\x00\x02\x00\x10\x10", 'binary file signature is preserved' );
|
||||
|
||||
my $original_cwd = getcwd();
|
||||
chdir File::Spec->tmpdir() or die "Unable to change directory: $!";
|
||||
is( slurp_repo_file($readme_relative), $readme, 'file reads do not depend on cwd' );
|
||||
chdir $original_cwd or die "Unable to restore directory: $!";
|
||||
|
||||
SKIP: {
|
||||
my $relative_link = 'xCAT-server/share/xcat/netboot/rocky/compute.rocky10.x86_64.pkglist';
|
||||
my $relative_target = 'xCAT-server/share/xcat/netboot/rh/compute.rhels10.x86_64.pkglist';
|
||||
skip 'repository symlink fixture is unavailable', 1 unless -l repo_path($relative_link);
|
||||
is( slurp_repo_file($relative_link), slurp_repo_file($relative_target), 'file reads follow repository symlinks' );
|
||||
}
|
||||
|
||||
my $missing_relative = 'xCAT-test/unit/does-not-exist';
|
||||
my $missing_path = repo_path($missing_relative);
|
||||
eval { slurp_repo_file($missing_relative) };
|
||||
like( $@, qr/Unable to open \Q$missing_path\E for reading:/, 'open failures identify the resolved repository path' );
|
||||
|
||||
my $directory_relative = 'xCAT-test/unit';
|
||||
my $directory_path = repo_path($directory_relative);
|
||||
eval { slurp_repo_file($directory_relative) };
|
||||
like( $@, qr/Unable to read \Q$directory_path\E:/, 'read failures identify the resolved repository path' );
|
||||
|
||||
foreach my $invalid ( '', File::Spec->rootdir(), File::Spec->catfile( 'xCAT-test', File::Spec->updir(), 'README' ) ) {
|
||||
eval { repo_path($invalid) };
|
||||
like( $@, qr/^Repository/, 'repo_path rejects paths outside its relative-path contract' );
|
||||
}
|
||||
eval { repo_path(undef) };
|
||||
like( $@, qr/^Repository-relative path is required/, 'repo_path rejects an undefined path' );
|
||||
|
||||
my $child_code = <<'PERL';
|
||||
BEGIN {
|
||||
no warnings 'redefine';
|
||||
*CORE::GLOBAL::close = sub (*) {
|
||||
$! = 5;
|
||||
return 0;
|
||||
};
|
||||
}
|
||||
use XCAT::Test::File qw(slurp_repo_file);
|
||||
eval { slurp_repo_file($ARGV[0]) };
|
||||
print $@;
|
||||
PERL
|
||||
|
||||
open(
|
||||
my $child,
|
||||
'-|',
|
||||
$^X,
|
||||
'-I' . repo_path('xCAT-test/lib'),
|
||||
'-e',
|
||||
$child_code,
|
||||
$readme_relative,
|
||||
) or die "Unable to start close-failure probe: $!";
|
||||
my $close_error = do { local $/; <$child> };
|
||||
close($child) or die "Close-failure probe failed: $?";
|
||||
like( $close_error, qr/Unable to close \Q$readme_path\E:/, 'close failures identify the resolved repository path' );
|
||||
|
||||
done_testing();
|
||||
@@ -3,43 +3,32 @@ use strict;
|
||||
use warnings;
|
||||
|
||||
use FindBin;
|
||||
use File::Spec;
|
||||
use lib "$FindBin::Bin/../lib";
|
||||
use Test::More;
|
||||
|
||||
my $repo_root = File::Spec->catdir( $FindBin::Bin, '..', '..' );
|
||||
use XCAT::Test::File qw(slurp_repo_file);
|
||||
|
||||
sub read_file {
|
||||
my ($file) = @_;
|
||||
my $path = File::Spec->catfile( $repo_root, $file );
|
||||
|
||||
open( my $fh, '<', $path ) or die "Unable to read $path: $!";
|
||||
my $contents = do { local $/; <$fh> };
|
||||
close($fh);
|
||||
|
||||
return $contents;
|
||||
}
|
||||
|
||||
my $debian_pm = read_file('xCAT-server/lib/xcat/plugins/debian.pm');
|
||||
my $debian_pm = slurp_repo_file('xCAT-server/lib/xcat/plugins/debian.pm');
|
||||
like( $debian_pm, qr/sub is_ubuntu_live_media/, 'copycds can detect Ubuntu live media' );
|
||||
like( $debian_pm, qr/casper\/install-sources\.yaml/, 'copycds recognizes Subiquity install source metadata' );
|
||||
like( $debian_pm, qr/casper\/\*\.squashfs/, 'copycds recognizes live squashfs media' );
|
||||
like( $debian_pm, qr/not a complete Ubuntu apt package mirror/, 'copycds warns that Ubuntu live media is not a complete apt mirror' );
|
||||
like( $debian_pm, qr/linuximage\.pkgdir.*linuximage\.otherpkgdir.*HTTP\/HTTPS Ubuntu apt repository/s, 'copycds warning points to explicit package source attributes' );
|
||||
|
||||
my $genimage = read_file('xCAT-server/share/xcat/netboot/ubuntu/genimage');
|
||||
my $genimage = slurp_repo_file('xCAT-server/share/xcat/netboot/ubuntu/genimage');
|
||||
unlike( $genimage, qr{http://archive\.ubuntu\.com/ubuntu/}, 'Ubuntu genimage does not implicitly use the public amd64 archive' );
|
||||
unlike( $genimage, qr{http://ports\.ubuntu\.com/ubuntu-ports/}, 'Ubuntu genimage does not implicitly use the public ports archive' );
|
||||
like( $genimage, qr{\$aptcmd2 = "--verbose --arch \$uarch \$dist \$rootimg_dir file://\$srcdir"}, 'Ubuntu genimage uses copied local media when no explicit mirror is configured' );
|
||||
like( $genimage, qr/copied Ubuntu media.*complete local Ubuntu apt mirror.*HTTP\/HTTPS Ubuntu apt repository/s, 'Ubuntu genimage gives an actionable package source error' );
|
||||
like( $genimage, qr{\@pkgdir_internet.*?\$aptcmd2 = "--verbose --arch \$uarch \$dist \$rootimg_dir \$mirrorurl"}s, 'Ubuntu genimage still honors an explicit mirror configured in pkgdir' );
|
||||
|
||||
my $copycds_doc = read_file('docs/source/guides/admin-guides/references/man8/copycds.8.rst');
|
||||
my $copycds_doc = slurp_repo_file('docs/source/guides/admin-guides/references/man8/copycds.8.rst');
|
||||
like( $copycds_doc, qr/Ubuntu live-server media.*not a complete Ubuntu apt package mirror/s, 'copycds documentation explains Ubuntu live media package limits' );
|
||||
|
||||
my $linuximage_doc = read_file('docs/source/guides/admin-guides/references/man5/linuximage.5.rst');
|
||||
my $linuximage_doc = slurp_repo_file('docs/source/guides/admin-guides/references/man5/linuximage.5.rst');
|
||||
like( $linuximage_doc, qr/Ubuntu live-server media copied by copycds is not a complete apt package mirror.*HTTP\/HTTPS Ubuntu apt repository/, 'linuximage documentation explains Ubuntu live media package limits' );
|
||||
|
||||
my $osimage_doc = read_file('docs/source/guides/admin-guides/references/man7/osimage.7.rst');
|
||||
my $osimage_doc = slurp_repo_file('docs/source/guides/admin-guides/references/man7/osimage.7.rst');
|
||||
like( $osimage_doc, qr/Ubuntu live-server media copied by copycds is not a complete apt package mirror.*HTTP\/HTTPS Ubuntu apt repository/, 'osimage documentation explains Ubuntu live media package limits' );
|
||||
|
||||
done_testing();
|
||||
|
||||
Reference in New Issue
Block a user