bike
/
gbootroot
mirror of https://github.com/fspc/gbootroot.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
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
ad7247f9a4
commit
dd24bae109
2 changed files with 129 additions and 113 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 228
      Yard.pm
  2. 12
      YardBox.pm

228
Yard.pm
View File

@ -34,7 +34,7 @@ use Exporter;
@EXPORT = qw(start_logging_output info kernel_version_check verbosity
read_contents_file extra_links library_dependencies hard_links
space_check create_filesystem find_file_in_path sys
text_insert logadj error *LOGFILE);
text_insert logadj error *LOGFILE which_tests);
use strict;
use File::Basename;
@ -57,7 +57,7 @@ my($Warnings) = 0;
my $verbosity;
my ($text_insert,$red,$blue);
my $logadj;
my $mount_point;
my ($device, $mount_point);
# This solves an annoying problem with the new Perl-5.6 built in glob,
# allowing earlier versions of Perl to run.
@ -99,7 +99,7 @@ sub kernel_version_check {
$ENV{'RELEASE'} = $kernel_version;
} 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 {
warning "Can't determine kernel version of $kernel\n";
my($release) = `uname -r`;
@ -744,10 +744,10 @@ sub space_check {
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) = @_;
my $device = "$mnt/$filename";
$device = "$mnt/$filename";
$mount_point = "$mnt/loopback";
my $file;
@ -782,7 +782,8 @@ sub create_filesystem {
if (!-d $mount_point) {
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
sys("rm -rf $mount_point/lost+found");
@ -1130,7 +1131,7 @@ sub start_logging_output {
}
# ERRORCHECK
## 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;
info(1, "Logging output to $logfile\n")
}
@ -1149,19 +1150,22 @@ sub sys {
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.
my (%mounted, %fs_type);
sub load_mount_info {
undef %::mounted;
undef %::fs_type;
undef %mounted;
undef %fs_type;
open(MTAB, "</etc/mtab") or die "Can't read /etc/mtab: $!\n";
while (<MTAB>) {
my($dev, $mp, $type) = split;
next if $dev eq 'none';
$::mounted{$dev} = $mp;
$::mounted{$mp} = $dev;
$::fs_type{$dev} = $type;
$mounted{$dev} = $mp;
$mounted{$mp} = $dev;
$fs_type{$dev} = $type;
}
close(MTAB);
}
@ -1169,21 +1173,22 @@ sub load_mount_info {
sub mount_device_if_necessary {
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) {
print "Device $::device already mounted on $::mount_point\n";
if ($mounted{$device} eq $mount_point) {
info(0, "Device $device already mounted on $mount_point\n");
} else {
print "$::device is mounted (on $::mounted{$::device})\n";
print "Can't mount it under $::mount_point.\n";
exit;
info(0, "$device is mounted \(on ", $mounted{$device}, "\)\n");
info(0, "Can't mount it under $mount_point.\n");
}
} elsif ($::mounted{$::mount_point} eq $::device) {
print "Another device (", $::mounted{$::mount_point};
print ") is already mounted on $::mount_point\n";
exit;
} elsif ($mounted{$mount_point} eq $device) {
info(0, "Another device \(", $mounted{$mount_point},
"\) is already mounted on $mount_point\n");
}
}
@ -1198,8 +1203,8 @@ sub must_be_abs {
sub sync {
# Parts of unix are still a black art
system("sync") and die "Couldn't sync!";
system("sync") and die "Couldn't sync!";
system("sync") and error("Couldn't sync!");
system("sync") and error("Couldn't sync!");
}
## Need to put error() checking here
@ -1212,8 +1217,6 @@ sub find_file_in_path {
my($file, @path) = @_;
if (!@path) {
##### Initialize @pathlist if necessary
if (!@pathlist) {
@ -1560,7 +1563,6 @@ sub check_device {
}
# Copy a file, substituting values for variables in the file.
# First try using a configuration variable (in CFG package),
# then issue a warning.
@ -1603,73 +1605,87 @@ sub onto_proc_filesystem {
}
1;
__END__
=pod
##############################################################################
#################
##
## CHECK_ROOT_FS
##
##############################################################################
#################
### GLOBAL VARIABLES
my(%Termcap); # Defs from /etc/termcap
my($checked_for_getty_files); # Scalar -- have we checked getty files yet?
my(%checked); # Hash table of files we've already checked
# 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.
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.");
my $login_binary;
##########################
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
#sub warning {
# info(0, "\n", @_);
# $Warnings++;
#}
## Originally, this was "$mount_point/usr/bin/login" but this is assuming
## to much. It is better just to find the local version since this varies
## from distribution to distribution, and more than likely this is the
## "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
# $::mount_point and runs the procedure.
# $mount_point and runs the procedure.
sub fork_chroot_and {
my($call) = @_;
my($Godot) = fork;
die "Can't fork: $!" unless defined $Godot;
#my($Godot) = fork;
#unless (defined $Godot) {
if (!$Godot) {
# my $error = error("Can't fork: $!");
# return "ERROR" if $error && $error eq "ERROR";
#}
#if (!$Godot) {
# Child process
chdir($::mount_point);
chroot($::mount_point); ##### chroot to the root filesystem
chdir($mount_point);
chroot($mount_point); ##### chroot to the root filesystem
&$call;
exit;
} else {
# We don't want the child hanging around on the root filesystem.
chdir("/");
chroot("/");
#} else {
# 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.
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");
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
-d ($::mount_point . $home) or
-d ($mount_point . $home) or
warning "$passwd_file($.): $line\n",
"\tHome directory of $login_name ($::mount_point$home) is missing\n";
-e ($::mount_point . $shell) or
"\tHome directory of $login_name ($mount_point$home) is missing\n";
-e ($mount_point . $shell) or
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);
}
@ -1849,8 +1865,8 @@ sub check_pam {
my($pam_configured) = 0; # Have we seen some pam config file yet?
info(0, "Checking for PAM\n");
my($pamd_dir) = "$::mount_point/etc/pam.d";
my($pam_conf) = "$::mount_point/etc/pam.conf";
my($pamd_dir) = "$mount_point/etc/pam.d";
my($pam_conf) = "$mount_point/etc/pam.conf";
if (-e $pam_conf) {
info(0, "Checking $pam_conf\n");
@ -1860,13 +1876,13 @@ sub check_pam {
chomp;
next if /^\#/ or /^\s*$/; # Skip comments and empty lines
my($file) = (split)[3]; # Get fourth field
if (!-e "$::mount_point/$file") {
if (!-e "$mount_point/$file") {
warning "$pam_conf($.): $_\n",
"\tLibrary $file does not exist on root fs\n";
}
# 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");
}
@ -1884,7 +1900,7 @@ sub check_pam {
next if /^\#/ or /^\s*$/; # Skip comments and empty lines
my($file) = (split)[3]; # Get fourth field
$pam_configured = 1;
if (!-e "$::mount_point/$file") {
if (!-e "$mount_point/$file") {
#warning "$file2($.): $_\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.
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");
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)|;
if (!defined($libc_version)) {
warning "Can't determine your libc version\n";
@ -1946,7 +1962,7 @@ sub check_nss {
my($entry);
for $entry (@entries) {
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) {
warning "$nss_conf($.):\n$line\n",
"\tRoot filesystem needs $lib to support $entry\n";
@ -1973,28 +1989,28 @@ sub check_nss {
sub check_links {
info(0, "\nChecking links relative to $::mount_point\n");
info(0, "\nChecking links relative to $mount_point\n");
sub wanted {
if (-l $File::Find::name) {
local($raw_link) = readlink($File::Find::name);
local($target) = make_link_absolute($File::Find::name, $raw_link);
local($::raw_link) = readlink($File::Find::name);
local($::target) = make_link_absolute($File::Find::name, $::raw_link);
# I added this next test for /dev/stdout link hair.
# This really should be more complicated to handle link chains,
# but as a hack this works for three.
if (onto_proc_filesystem($File::Find::name)) {
} elsif (-l $target) {
chase_link($target, 16);
} elsif (-l $::target) {
chase_link($::target, 16);
} elsif (!-e $target) {
warning "Warning: Unresolved link: $File::Find::name -> $raw_link\n";
} elsif (!-e $::target) {
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 {
info(0, "\nChecking script interpreters\n");
local($prog);
local($::prog);
sub check_interpreter {
if (-x $File::Find::name and -f _ and -T _) {
@ -2041,7 +2057,7 @@ sub check_getty_type_call {
if ($prog eq 'getty') {
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";
}
if (!defined($Termcap{$type})) {
@ -2054,9 +2070,9 @@ sub check_getty_type_call {
if ($prog =~ /^getty/) {
if (!$checked_for_getty_files) {
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"
unless -e "$::mount_point/etc/issue";
unless -e "$mount_point/etc/issue";
$checked_for_getty_files = 1;
}
}
@ -2096,7 +2112,7 @@ sub check_init_files {
my($init_file);
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;
@ -2126,7 +2142,7 @@ sub check_init_files {
($cmd) = /^(\w+)\b/; # Pick up cmd name
if ($cmd and ($hd_abs = find_file_in_path($cmd, @path))) {
# 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",
"\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
# Note that this could mislead if the user moved it to a different
# 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";
} elsif (!-x _) {
warning "$init_file($.): $_\n\t$cmd: not executable on root fs.\n";
@ -2154,8 +2170,8 @@ sub check_init_files {
sub check_termcap {
open(TERMCAP, "<$::mount_point/etc/termcap") or
warning "No file $::mount_point/etc/termcap";
open(TERMCAP, "<$mount_point/etc/termcap") or
warning "No file $mount_point/etc/termcap";
while (<TERMCAP>) {
chomp;
next unless $_;
@ -2179,8 +2195,8 @@ sub check_termcap {
}
##### END OF CHECK_ROOT_FS
=cut
1;

12
YardBox.pm
View File

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

Write Preview
Loading…
Cancel
Save