Browse Source

* Added all the Tests. The problem is that three of the tests use chroot.

Even with forking, the old cwd is never returned to the parent process.
  There should be a way of preventing this.
master
freesource 24 years ago
parent
commit
dd24bae109
  1. 228
      Yard.pm
  2. 12
      YardBox.pm

228
Yard.pm

@ -34,7 +34,7 @@ use Exporter;
@EXPORT = qw(start_logging_output info kernel_version_check verbosity @EXPORT = qw(start_logging_output info kernel_version_check verbosity
read_contents_file extra_links library_dependencies hard_links read_contents_file extra_links library_dependencies hard_links
space_check create_filesystem find_file_in_path sys space_check create_filesystem find_file_in_path sys
text_insert logadj error *LOGFILE); text_insert logadj error *LOGFILE which_tests);
use strict; use strict;
use File::Basename; use File::Basename;
@ -57,7 +57,7 @@ my($Warnings) = 0;
my $verbosity; my $verbosity;
my ($text_insert,$red,$blue); my ($text_insert,$red,$blue);
my $logadj; my $logadj;
my $mount_point; my ($device, $mount_point);
# This solves an annoying problem with the new Perl-5.6 built in glob, # This solves an annoying problem with the new Perl-5.6 built in glob,
# allowing earlier versions of Perl to run. # allowing earlier versions of Perl to run.
@ -99,7 +99,7 @@ sub kernel_version_check {
$ENV{'RELEASE'} = $kernel_version; $ENV{'RELEASE'} = $kernel_version;
} elsif (defined($ENV{'RELEASE'} = kernel_version($kernel))) { } elsif (defined($ENV{'RELEASE'} = kernel_version($kernel))) {
info(0, "Version probe of $kernel returns: $ENV{'RELEASE'}\n"); info(0, "\nVersion probe of $kernel returns: $ENV{'RELEASE'}\n");
} else { } else {
warning "Can't determine kernel version of $kernel\n"; warning "Can't determine kernel version of $kernel\n";
my($release) = `uname -r`; my($release) = `uname -r`;
@ -744,10 +744,10 @@ sub space_check {
sub create_filesystem { sub create_filesystem {
my ($filename, $fs_size,$ fs_type, $inode_size, $mnt, $strip_lib, my ($filename, $fs_size, $fs_type, $inode_size, $mnt, $strip_lib,
$strip_bin, $strip_module, $obj_count) = @_; $strip_bin, $strip_module, $obj_count) = @_;
my $device = "$mnt/$filename"; $device = "$mnt/$filename";
$mount_point = "$mnt/loopback"; $mount_point = "$mnt/loopback";
my $file; my $file;
@ -782,7 +782,8 @@ sub create_filesystem {
if (!-d $mount_point) { if (!-d $mount_point) {
return "ERROR" if errmk(sys("mkdir $mount_point")) == 2; return "ERROR" if errmk(sys("mkdir $mount_point")) == 2;
} }
mount_device($device,$mount_point);
return "ERROR" if errm(mount_device($device,$mount_point)) == 2;
##### lost+found on a ramdisk is pointless ##### lost+found on a ramdisk is pointless
sys("rm -rf $mount_point/lost+found"); sys("rm -rf $mount_point/lost+found");
@ -1130,7 +1131,7 @@ sub start_logging_output {
} }
# ERRORCHECK # ERRORCHECK
## If logfile doesn't open in /tmp there is some type of fatal problem. ## If logfile doesn't open in /tmp there is some type of fatal problem.
open(LOGFILE, ">>$logfile") or die "open($logfile): $!\n"; open(LOGFILE, ">>$logfile") or error("open($logfile): $!\n");
# &::verbosity_box() if !visible $verbosity_window; # &::verbosity_box() if !visible $verbosity_window;
info(1, "Logging output to $logfile\n") info(1, "Logging output to $logfile\n")
} }
@ -1149,19 +1150,22 @@ sub sys {
0; # like system() 0; # like system()
} }
# Maybe history but @mount_device_if_necessary() uses it. # This is history, simply because the mount point is unique to
# the session, and umount is always used between stages, and
# there are checks in place for it's failure.
# Just need to add error_window. # Just need to add error_window.
my (%mounted, %fs_type);
sub load_mount_info { sub load_mount_info {
undef %::mounted; undef %mounted;
undef %::fs_type; undef %fs_type;
open(MTAB, "</etc/mtab") or die "Can't read /etc/mtab: $!\n"; open(MTAB, "</etc/mtab") or die "Can't read /etc/mtab: $!\n";
while (<MTAB>) { while (<MTAB>) {
my($dev, $mp, $type) = split; my($dev, $mp, $type) = split;
next if $dev eq 'none'; next if $dev eq 'none';
$::mounted{$dev} = $mp; $mounted{$dev} = $mp;
$::mounted{$mp} = $dev; $mounted{$mp} = $dev;
$::fs_type{$dev} = $type; $fs_type{$dev} = $type;
} }
close(MTAB); close(MTAB);
} }
@ -1169,21 +1173,22 @@ sub load_mount_info {
sub mount_device_if_necessary { sub mount_device_if_necessary {
load_mount_info(); load_mount_info();
if (defined($::mounted{$::device})) { # obviously these should be lexical to the whole package.
my ($device,$mount_point);
if (defined($mounted{$device})) {
if ($::mounted{$::device} eq $::mount_point) { if ($mounted{$device} eq $mount_point) {
print "Device $::device already mounted on $::mount_point\n"; info(0, "Device $device already mounted on $mount_point\n");
} else { } else {
print "$::device is mounted (on $::mounted{$::device})\n"; info(0, "$device is mounted \(on ", $mounted{$device}, "\)\n");
print "Can't mount it under $::mount_point.\n"; info(0, "Can't mount it under $mount_point.\n");
exit;
} }
} elsif ($::mounted{$::mount_point} eq $::device) { } elsif ($mounted{$mount_point} eq $device) {
print "Another device (", $::mounted{$::mount_point}; info(0, "Another device \(", $mounted{$mount_point},
print ") is already mounted on $::mount_point\n"; "\) is already mounted on $mount_point\n");
exit;
} }
} }
@ -1198,8 +1203,8 @@ sub must_be_abs {
sub sync { sub sync {
# Parts of unix are still a black art # Parts of unix are still a black art
system("sync") and die "Couldn't sync!"; system("sync") and error("Couldn't sync!");
system("sync") and die "Couldn't sync!"; system("sync") and error("Couldn't sync!");
} }
## Need to put error() checking here ## Need to put error() checking here
@ -1212,8 +1217,6 @@ sub find_file_in_path {
my($file, @path) = @_; my($file, @path) = @_;
if (!@path) { if (!@path) {
##### Initialize @pathlist if necessary ##### Initialize @pathlist if necessary
if (!@pathlist) { if (!@pathlist) {
@ -1560,7 +1563,6 @@ sub check_device {
} }
# Copy a file, substituting values for variables in the file. # Copy a file, substituting values for variables in the file.
# First try using a configuration variable (in CFG package), # First try using a configuration variable (in CFG package),
# then issue a warning. # then issue a warning.
@ -1603,73 +1605,87 @@ sub onto_proc_filesystem {
} }
1; #################
__END__
=pod
##############################################################################
## ##
## CHECK_ROOT_FS ## CHECK_ROOT_FS
## ##
############################################################################## #################
### GLOBAL VARIABLES ### GLOBAL VARIABLES
my(%Termcap); # Defs from /etc/termcap my(%Termcap); # Defs from /etc/termcap
my($checked_for_getty_files); # Scalar -- have we checked getty files yet? my($checked_for_getty_files); # Scalar -- have we checked getty files yet?
my(%checked); # Hash table of files we've already checked my(%checked); # Hash table of files we've already checked
# This is a little crude. Technically we should read /etc/conf.getty my $login_binary;
# to make sure we're not supposed to be using a different login binary.
my($login_binary) = "$mount_point/bin/login";
## Maybe this
##@mount_device_if_necessary();
# This goes first so we define %Termcap for use in children
check_termcap();
##### Here are the tests.
fork_chroot_and(\&check_fstab);
fork_chroot_and(\&check_inittab);
fork_chroot_and(\&check_scripts);
check_links();
check_passwd();
check_pam();
check_nss();
info(0, "All done!\n");
info(0, "You can run more tests with the UML kernel,\n
or construct a distribution by using this root\n
filesystem with a boot method.");
########################## sub which_tests {
my ($chosen_tests) = @_;
my ($action, $label);
return "ERROR" if errm(mount_device($device,$mount_point)) == 2;
# This is a little crude. Technically we should read /etc/conf.getty
# to make sure we're not supposed to be using a different login binary.
# I think we will just add all warnings together ## Originally, this was "$mount_point/usr/bin/login" but this is assuming
#sub warning { ## to much. It is better just to find the local version since this varies
# info(0, "\n", @_); ## from distribution to distribution, and more than likely this is the
# $Warnings++; ## "login" used in the mounted version, too.
#} ## Once PATH is complete, there will be a separate check just to look at
## the non-local $mount_point PATH.
$login_binary = "$mount_point" . find_file_in_path("login");
# This goes first so we define %Termcap for use in children
check_termcap();
##### Here are the tests.
fork_chroot_and(\&check_fstab) if $chosen_tests->{30}{test_fstab} == 1;
fork_chroot_and(\&check_inittab)if $chosen_tests->{31}{test_inittab} == 1;
fork_chroot_and(\&check_scripts)if $chosen_tests->{32}{test_scripts} == 1;
check_links() if $chosen_tests->{33}{test_links} == 1;
check_passwd() if $chosen_tests->{34}{test_passwd} == 1;
check_pam() if $chosen_tests->{35}{test_pam} == 1;
check_nss() if $chosen_tests->{36}{test_nss} == 1;
return "ERROR" if errum(sys("umount $mount_point")) == 2;
info(0, "All done!\n");
info(0, "You can run more tests with the UML kernel\n",
"or construct a distribution by using this root\n",
"filesystem with a boot method.");
} # end sub which_tests
# This takes a procedure call, forks off a subprocess, chroots to # This takes a procedure call, forks off a subprocess, chroots to
# $::mount_point and runs the procedure. # $mount_point and runs the procedure.
sub fork_chroot_and { sub fork_chroot_and {
my($call) = @_; my($call) = @_;
my($Godot) = fork; #my($Godot) = fork;
die "Can't fork: $!" unless defined $Godot;
#unless (defined $Godot) {
if (!$Godot) { # my $error = error("Can't fork: $!");
# return "ERROR" if $error && $error eq "ERROR";
#}
#if (!$Godot) {
# Child process # Child process
chdir($::mount_point); chdir($mount_point);
chroot($::mount_point); ##### chroot to the root filesystem chroot($mount_point); ##### chroot to the root filesystem
&$call; &$call;
exit; # We don't want the child hanging around on the root filesystem.
chdir("/");
} else { chroot("/");
#} else {
# Parent here # Parent here
waitpid($Godot, 0); # waitpid($Godot, 0);
} # chdir("/");
# chroot("/");
#}
} }
@ -1815,7 +1831,7 @@ sub scan_command_file {
##### Check_passwd is NOT run under chroot. ##### Check_passwd is NOT run under chroot.
sub check_passwd { sub check_passwd {
my($passwd_file) = "$::mount_point/etc/passwd"; my($passwd_file) = "$mount_point/etc/passwd";
open(PASSWD, "<$passwd_file") or error("Can't read passwd file: $!\n"); open(PASSWD, "<$passwd_file") or error("Can't read passwd file: $!\n");
info(0, "\nChecking passwd file $passwd_file\n"); info(0, "\nChecking passwd file $passwd_file\n");
@ -1828,12 +1844,12 @@ sub check_passwd {
next if $passwd eq "*"; # Skip warnings if user can't login next if $passwd eq "*"; # Skip warnings if user can't login
-d ($::mount_point . $home) or -d ($mount_point . $home) or
warning "$passwd_file($.): $line\n", warning "$passwd_file($.): $line\n",
"\tHome directory of $login_name ($::mount_point$home) is missing\n"; "\tHome directory of $login_name ($mount_point$home) is missing\n";
-e ($::mount_point . $shell) or -e ($mount_point . $shell) or
warning "$passwd_file($.): $line\n", warning "$passwd_file($.): $line\n",
"\tShell of $login_name ($::mount_point$shell) doesn't exist\n"; "\tShell of $login_name ($mount_point$shell) doesn't exist\n";
check_init_files($login_name, $home, $shell); check_init_files($login_name, $home, $shell);
} }
@ -1849,8 +1865,8 @@ sub check_pam {
my($pam_configured) = 0; # Have we seen some pam config file yet? my($pam_configured) = 0; # Have we seen some pam config file yet?
info(0, "Checking for PAM\n"); info(0, "Checking for PAM\n");
my($pamd_dir) = "$::mount_point/etc/pam.d"; my($pamd_dir) = "$mount_point/etc/pam.d";
my($pam_conf) = "$::mount_point/etc/pam.conf"; my($pam_conf) = "$mount_point/etc/pam.conf";
if (-e $pam_conf) { if (-e $pam_conf) {
info(0, "Checking $pam_conf\n"); info(0, "Checking $pam_conf\n");
@ -1860,13 +1876,13 @@ sub check_pam {
chomp; chomp;
next if /^\#/ or /^\s*$/; # Skip comments and empty lines next if /^\#/ or /^\s*$/; # Skip comments and empty lines
my($file) = (split)[3]; # Get fourth field my($file) = (split)[3]; # Get fourth field
if (!-e "$::mount_point/$file") { if (!-e "$mount_point/$file") {
warning "$pam_conf($.): $_\n", warning "$pam_conf($.): $_\n",
"\tLibrary $file does not exist on root fs\n"; "\tLibrary $file does not exist on root fs\n";
} }
# That's all we check for now # That's all we check for now
} }
close(PAM) or die "Closing PAM: $!"; close(PAM) or error("Closing PAM: $!");
info(0, "Done with $pam_conf\n"); info(0, "Done with $pam_conf\n");
} }
@ -1884,7 +1900,7 @@ sub check_pam {
next if /^\#/ or /^\s*$/; # Skip comments and empty lines next if /^\#/ or /^\s*$/; # Skip comments and empty lines
my($file) = (split)[3]; # Get fourth field my($file) = (split)[3]; # Get fourth field
$pam_configured = 1; $pam_configured = 1;
if (!-e "$::mount_point/$file") { if (!-e "$mount_point/$file") {
#warning "$file2($.): $_\n", #warning "$file2($.): $_\n",
# "\tLibrary $file does not exist on root fs\n"; # "\tLibrary $file does not exist on root fs\n";
} }
@ -1919,10 +1935,10 @@ sub check_pam {
##### is 1 for glibc 2.0 and 2 for glibc 2.1. ##### is 1 for glibc 2.0 and 2 for glibc 2.1.
sub check_nss { sub check_nss {
my($nss_conf) = "$::mount_point/etc/nsswitch.conf"; my($nss_conf) = "$mount_point/etc/nsswitch.conf";
info(0, "Checking for NSS\n"); info(0, "Checking for NSS\n");
my($libc) = yard_glob("$::mount_point/lib/libc-2*"); my($libc) = yard_glob("$mount_point/lib/libc-2*");
my($libc_version) = $libc =~ m|/lib/libc-2.(\d)|; my($libc_version) = $libc =~ m|/lib/libc-2.(\d)|;
if (!defined($libc_version)) { if (!defined($libc_version)) {
warning "Can't determine your libc version\n"; warning "Can't determine your libc version\n";
@ -1946,7 +1962,7 @@ sub check_nss {
my($entry); my($entry);
for $entry (@entries) { for $entry (@entries) {
next if $entry =~ /^\[/; # ignore action specifiers next if $entry =~ /^\[/; # ignore action specifiers
my($lib) = "$::mount_point/lib/libnss_${entry}.so.${X}"; my($lib) = "$mount_point/lib/libnss_${entry}.so.${X}";
if (!-e $lib) { if (!-e $lib) {
warning "$nss_conf($.):\n$line\n", warning "$nss_conf($.):\n$line\n",
"\tRoot filesystem needs $lib to support $entry\n"; "\tRoot filesystem needs $lib to support $entry\n";
@ -1973,28 +1989,28 @@ sub check_nss {
sub check_links { sub check_links {
info(0, "\nChecking links relative to $::mount_point\n"); info(0, "\nChecking links relative to $mount_point\n");
sub wanted { sub wanted {
if (-l $File::Find::name) { if (-l $File::Find::name) {
local($raw_link) = readlink($File::Find::name); local($::raw_link) = readlink($File::Find::name);
local($target) = make_link_absolute($File::Find::name, $raw_link); local($::target) = make_link_absolute($File::Find::name, $::raw_link);
# I added this next test for /dev/stdout link hair. # I added this next test for /dev/stdout link hair.
# This really should be more complicated to handle link chains, # This really should be more complicated to handle link chains,
# but as a hack this works for three. # but as a hack this works for three.
if (onto_proc_filesystem($File::Find::name)) { if (onto_proc_filesystem($File::Find::name)) {
} elsif (-l $target) { } elsif (-l $::target) {
chase_link($target, 16); chase_link($::target, 16);
} elsif (!-e $target) { } elsif (!-e $::target) {
warning "Warning: Unresolved link: $File::Find::name -> $raw_link\n"; warning "Warning: Unresolved link: $File::Find::name -> $::raw_link\n";
} }
} }
}; };
finddepth(\&wanted, $::mount_point); finddepth(\&wanted, $mount_point);
} }
@ -2013,7 +2029,7 @@ sub chase_link {
sub check_scripts { sub check_scripts {
info(0, "\nChecking script interpreters\n"); info(0, "\nChecking script interpreters\n");
local($prog); local($::prog);
sub check_interpreter { sub check_interpreter {
if (-x $File::Find::name and -f _ and -T _) { if (-x $File::Find::name and -f _ and -T _) {
@ -2041,7 +2057,7 @@ sub check_getty_type_call {
if ($prog eq 'getty') { if ($prog eq 'getty') {
my($tty, $speed, $type) = @args; my($tty, $speed, $type) = @args;
if (!-e "$::mount_point/dev/$tty") { if (!-e "$mount_point/dev/$tty") {
warning "\tLine $.: $prog for $tty, but /dev/$tty doesn't exist.\n"; warning "\tLine $.: $prog for $tty, but /dev/$tty doesn't exist.\n";
} }
if (!defined($Termcap{$type})) { if (!defined($Termcap{$type})) {
@ -2054,9 +2070,9 @@ sub check_getty_type_call {
if ($prog =~ /^getty/) { if ($prog =~ /^getty/) {
if (!$checked_for_getty_files) { if (!$checked_for_getty_files) {
warning "\tLine $.: $prog expects /etc/gettydefs, which is missing.\n" warning "\tLine $.: $prog expects /etc/gettydefs, which is missing.\n"
unless -e "$::mount_point/etc/gettydefs"; unless -e "$mount_point/etc/gettydefs";
warning "\tLine $.: $prog expects /etc/issue, which is missing.\n" warning "\tLine $.: $prog expects /etc/issue, which is missing.\n"
unless -e "$::mount_point/etc/issue"; unless -e "$mount_point/etc/issue";
$checked_for_getty_files = 1; $checked_for_getty_files = 1;
} }
} }
@ -2096,7 +2112,7 @@ sub check_init_files {
my($init_file); my($init_file);
foreach $init_file (@init_files) { foreach $init_file (@init_files) {
$init_file = $::mount_point . $init_file; $init_file = $mount_point . $init_file;
next if $checked{$init_file} or !-r $init_file; next if $checked{$init_file} or !-r $init_file;
@ -2126,7 +2142,7 @@ sub check_init_files {
($cmd) = /^(\w+)\b/; # Pick up cmd name ($cmd) = /^(\w+)\b/; # Pick up cmd name
if ($cmd and ($hd_abs = find_file_in_path($cmd, @path))) { if ($cmd and ($hd_abs = find_file_in_path($cmd, @path))) {
# If it's here, see if it's on the rescue disk # If it's here, see if it's on the rescue disk
if (!(-e "$::mount_point/$hd_abs" and -x _)) { if (!(-e "$mount_point/$hd_abs" and -x _)) {
warning "$init_file($.): $_\n\t\t$cmd looks like a command but\n", warning "$init_file($.): $_\n\t\t$cmd looks like a command but\n",
"\t\tdoes not exist on the root filesystem.\n"; "\t\tdoes not exist on the root filesystem.\n";
} }
@ -2138,7 +2154,7 @@ sub check_init_files {
# If it's here, see if it's on the rescue disk # If it's here, see if it's on the rescue disk
# Note that this could mislead if the user moved it to a different # Note that this could mislead if the user moved it to a different
# dir on the root fs. # dir on the root fs.
if (!-e "$::mount_point/$hd_abs") { if (!-e "$mount_point/$hd_abs") {
warning "${init_file}($.): $_\n\t$cmd: missing from root fs.\n"; warning "${init_file}($.): $_\n\t$cmd: missing from root fs.\n";
} elsif (!-x _) { } elsif (!-x _) {
warning "$init_file($.): $_\n\t$cmd: not executable on root fs.\n"; warning "$init_file($.): $_\n\t$cmd: not executable on root fs.\n";
@ -2154,8 +2170,8 @@ sub check_init_files {
sub check_termcap { sub check_termcap {
open(TERMCAP, "<$::mount_point/etc/termcap") or open(TERMCAP, "<$mount_point/etc/termcap") or
warning "No file $::mount_point/etc/termcap"; warning "No file $mount_point/etc/termcap";
while (<TERMCAP>) { while (<TERMCAP>) {
chomp; chomp;
next unless $_; next unless $_;
@ -2179,8 +2195,8 @@ sub check_termcap {
} }
##### END OF CHECK_ROOT_FS ##### END OF CHECK_ROOT_FS
=cut
1;

12
YardBox.pm

@ -545,12 +545,6 @@ sub create {
} }
sub test {
}
######### #########
# TESTS # # TESTS #
######### #########
@ -595,6 +589,12 @@ sub tests {
} }
sub test {
$error = which_tests(\%tests);
return if $error && $error eq "ERROR";
}
######################### #########################
# CHECK STAGE VARIABLES # # CHECK STAGE VARIABLES #
######################### #########################

Loading…
Cancel
Save