From cd956e12e1280200b638b68d08542c32f8cdb546 Mon Sep 17 00:00:00 2001 From: freesource Date: Thu, 19 Oct 2000 05:05:39 +0000 Subject: [PATCH] Strict cleanup for make_root. --- Yard.pm | 1526 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 774 insertions(+), 752 deletions(-) diff --git a/Yard.pm b/Yard.pm index 778a345..12c46ba 100644 --- a/Yard.pm +++ b/Yard.pm @@ -73,6 +73,27 @@ use File::Find; # used by check_root_fs ############################################ ############################################ +# Probably will make this local .. actually don't need them + +# FROM YARD_UTILS.PL + +# constant.pm not introduced until 5.003_96, so these are +# just global variables. +# Constants from /usr/src/linux/arch/i386/kernel/setup.c: +#$::RAMDISK_IMAGE_START_MASK = 0x07FF; +#$::RAMDISK_PROMPT_FLAG = 0x8000; +#$::RAMDISK_LOAD_FLAG = 0x4000; + +# ioctls from /usr/include/linux/fs.h: +#$::BLKGETSIZE_ioctl = 4704; +#$::BLKFLSBUF_ioctl = 4705; + +# ext2 fs constants, both in bytes +#$::EXT2_BLOCK_SIZE = 1024; +#$::INODE_SIZE = 1024; + +########################## +########################### # BEGIN { require "yard_utils.pl"; } # Supplied by gBootroot @@ -81,14 +102,16 @@ use File::Find; # used by check_root_fs STDOUT->autoflush(1); start_logging_output(); -info 0, "make_root_fs @yard_version@\n"; -info 1, "(running under Perl $PERL_VERSION)\n"; -my($objcopy) = $_path{'objcopy'}; # Define objcopy path if executable exists +info(0, "root_fs\n"); +info(1, "(running under Perl $PERL_VERSION)\n"); + +#my($objcopy) = $_path{'objcopy'}; # Define objcopy path if executable exists +my $objcopy = "objcopy"; my($Warnings) = 0; sub warning { - info 0, "Warning: ", @_; + info(0, "Warning: ", @_); $Warnings++; } @@ -98,43 +121,48 @@ sub warning { ##### a set of user options (via a Perl module), but I'm too lazy ##### to track it down. ############################################################################## -if ($REAL_USER_ID != 0) { - error "This script must be run as root\n"; -} +# Too restrictive for gBootRoot +#if ($REAL_USER_ID != 0) { +# error("This script must be run as root\n"); +#} -if (!defined($::device) and !defined($::mount_point)) { - error "Nothing defined in CFG package. You probably just copied\n", - "an old Config.pl file.\n"; -} +# Not necessary, gBootRoot handles this stuff. +#if (!defined($::device) and !defined($::mount_point)) { +# error("Nothing defined in CFG package. You probably just copied\n", +# "an old Config.pl file.\n"; +#} # Check mount point -if (-d $::mount_point and -w _) { - info 1, "Using $::mount_point as mount point for $::device\n"; -} else { - error "Mount point $::mount_point must be a directory and\n", - "must be write-enabled.\n"; -} +#if (-d $::mount_point and -w _) { +# info(1, "Using $::mount_point as mount point for $::device\n"); +#} else { +# error("Mount point $::mount_point must be a directory and\n", +# "must be write-enabled.\n"; +#} +# This is a good thing to be used for all device checking in +# gBootRoot, but it may be restrictive since sometimes it is a +# good thing to mount a whole device .. cdroms for instance. # Check for sane device choice before we start using it. check_device(); # Make sure $::device isn't already mounted and $::mount_point is free load_mount_info(); -if (defined($mounted{$::device})) { +if (defined($::mounted{$::device})) { - if ($mounted{$::device} eq $::mount_point) { - info 1, "Device $::device is already mounted on $::mount_point\n"; - info 1, "Unmounting it automatically.\n"; + if ($::mounted{$::device} eq $::mount_point) { + #info(1, "Device $::device is already mounted on $::mount_point\n"); + info(1, "Unmounting it automatically.\n"); sys("umount $::mount_point"); } else { - error "$::device is already mounted elsewhere (on $mounted{$::device})\n", - "Unmount it first.\n"; + error("$::device is already mounted elsewhere (on $::mounted{$::device})\n", + "Unmount it first.\n"); } -} elsif (defined($mounted{$::mount_point})) { - error "Some other device is already mounted on $::mount_point\n"; +} elsif (defined($::mounted{$::mount_point})) { + error("Some other device is already mounted on $::mount_point\n"); } # Have to test this every time so we can work around. @@ -146,49 +174,50 @@ if (defined($::kernel_version)) { # Check to see if it agrees my($version_guess) = kernel_version($::kernel); if ($version_guess ne $::kernel_version) { - info 0, "You declared kernel ($::kernel) to be version $::kernel_version,\n", - "\teven though a probe says $version_guess.", - "\tI'll assume you're right.\n"; + # info(0, + # "You declared kernel ($::kernel) to be version $::kernel_version\n", + # "\teven though a probe says $version_guess.", + # "\tI'll assume you're right.\n";) } $ENV{'RELEASE'} = $::kernel_version; } elsif (defined($ENV{'RELEASE'} = kernel_version($::kernel))) { - info 0, "Version probe of $::kernel returns: $ENV{'RELEASE'}\n"; + info(0, "Version probe of $::kernel returns: $ENV{'RELEASE'}\n"); } else { warning "Can't determine kernel version of $::kernel\n"; my($release) = `uname -r`; if ($release) { chomp($release); - info 0, "Will use version of current running kernel ($release)\n", - "Make sure this is OK\n"; + info(0, "Will use version of current running kernel ($release)\n", + "Make sure this is OK\n"); $ENV{'RELEASE'} = $release; } else { - error "And can't determine running kernel's version either!\n"; + error("And can't determine running kernel's version either!\n"); } } warn_about_module_dependencies($ENV{'RELEASE'}); if ($::disk_set !~ /^(single|double|base\+extra)$/) { - error "Config variable disk_set is set to \"$::disk_set\"\n", - "which is not a valid value.\n"; + error("Config variable disk_set is set to \"$::disk_set\"\n", + "which is not a valid value.\n"); } ############################################################################## ##### READ IN CONTENTS FILE ##### ############################################################################## my($contents_file) = resolve_file($::contents_file); -info 0, "\n\nPASS 1: Reading $::contents_file"; -info 0, " ($contents_file)" if $contents_file ne $::contents_file; -info 0, "\n"; +info(0, "\n\nPASS 1: Reading $::contents_file"); +#info 0, " ($contents_file)" if $contents_file ne $::contents_file; +info(0, "\n"); my(%Included); my(%replaced_by); my(%links_to); my(%is_module); -open(CONTENTS, "<$contents_file") or error "$contents_file: $!"; +open(CONTENTS, "<$contents_file") or error("$contents_file: $!"); my($cf_line) = 0; my($line); @@ -229,7 +258,7 @@ LINE: while (defined($line = )) { my($abs_link) = make_link_absolute($abs_file, $link); my($rel_link) = make_link_relative($abs_file, $link); $links_to{$abs_file} = $rel_link; - info 1, "$line links $abs_file to $rel_link\n"; + info(1, "$line links $abs_file to $rel_link\n"); @files = ($abs_link); } elsif ($line =~ /<=/) { ##### REPLACEMENT SPEC @@ -274,7 +303,7 @@ LINE: while (defined($line = )) { if ($#globbed == -1) { cf_warn($line, "Warning: No files matched $expr"); } elsif (!($#globbed == 0 and $globbed[0] eq $expr)) { - info 1, "Expanding $expr to @globbed\n"; + info(1, "Expanding $expr to @globbed\n"); } push(@files, @globbed); } @@ -286,7 +315,7 @@ LINE: while (defined($line = )) { if ($file =~ m|^/|) { ##### Absolute filename if (-l $file and readlink($file) =~ m|^/proc/|) { - info 1, "Recording proc link $file -> ", readlink($file), "\n"; + info(1, "Recording proc link $file -> ", readlink($file), "\n"); $Included{$file} = 1; $links_to{$file} = readlink($file); @@ -306,7 +335,7 @@ LINE: while (defined($line = )) { } else { ##### Relative filename my($abs_file) = find_file_in_path($file); if ($abs_file) { - info 1, "Found $file at $abs_file\n"; + info(1, "Found $file at $abs_file\n"); $Included{$abs_file} = 1; } else { cf_warn($line, "Didn't find $file anywhere in path"); @@ -315,7 +344,7 @@ LINE: while (defined($line = )) { } # End of FILE loop } # End of LINE loop -info 0, "\nDone with $contents_file\n\n"; +info(0, "\nDone with $contents_file\n\n"); if ($::disk_set eq "base+extra") { include_file(find_file_in_path("tar")) @@ -325,18 +354,18 @@ close(CONTENTS) or error("close on $contents_file: $!"); ############################################################################## -info 0, "\n\nPASS 2: Picking up extra files from links...\n"; +info(0, "\n\nPASS 2: Picking up extra files from links...\n"); for (keys %Included) { include_file($_); } -info 0, "Done.\n\n"; +info(0, "Done.\n\n"); ############################################################################## -info 0, "PASS 3: Checking library dependencies...\n"; -info 1, "(Ignore any 'statically linked' messages.)\n"; +info(0, "PASS 3: Checking library dependencies...\n"); +info(1, "(Ignore any 'statically linked' messages.)\n"); # Normal file X: X in %Included. # X -> Y: X in %links_to, Y in %Included @@ -365,7 +394,7 @@ foreach $file (keys %Included) { ##### See whether it's a module and mark the info for later ##### so that we strip it correctly. if ($file_line =~ m/relocatable/) { - info 1, "Marking $file as a module\n"; + info(1, "Marking $file as a module\n"); $is_module{$file} = 1; } elsif ($file_line =~ m/shared object/) { @@ -404,13 +433,13 @@ foreach $file (keys %Included) { } last unless -l $abs_lib; my($link) = readlink($abs_lib) or - error "readlink($abs_lib): $!"; + error("readlink($abs_lib): $!"); $abs_lib = make_link_absolute($abs_lib, $link); } } if (!defined($lib_needed_by{$abs_lib})) { - info 0, "\t$abs_lib\n"; + info(0, "\t$abs_lib\n"); } push(@{$lib_needed_by{$abs_lib}}, $file); } @@ -426,7 +455,7 @@ my($seen_ELF_lib, $seen_AOUT_lib); my(%full_name); if (@Libs) { - info 1, "\nYou need these libraries:\n"; + info(1, "\nYou need these libraries:\n"); my($lib); foreach $lib (@Libs) { @@ -435,9 +464,9 @@ if (@Libs) { my($file_output) = `file $lib`; if ($file_output =~ m/symbolic link/) { - error "Yiiiiii, library file $lib is a symbolic link!\n", + error("Yiiiiii, library file $lib is a symbolic link!\n", "This shouldn't happen!\n", - "Please report this error to the Yard author\n"; + "Please report this error(to the Yard author\n"); } my($lib_type) = $file_output =~ /:\s*(ELF|Linux)/m; @@ -445,17 +474,17 @@ if (@Libs) { ##### All libraries are strippable $strippable{$lib} = 1; - info 1, "$lib (type $lib_type, $size K) needed by:\n"; + info(1, "$lib (type $lib_type, $size K) needed by:\n"); my($binary); for $binary (sort map(basename($_), @{$lib_needed_by{$lib}})) { if (length($line) + length($binary) > 78) { - info 1, $line, "\n"; + info(1, $line, "\n"); $line = " " x 15; } $line .= $binary . " "; } - info 1, $line, "\n" if $line; + #info(1, $line, "\n" if $line); if (!($seen_ELF_lib and $seen_AOUT_lib)) { @@ -464,8 +493,8 @@ if (@Libs) { ##### Strings from /usr/lib/magic of file 3.19 if (!defined($lib_type)) { - error "Didn't understand `file` output for $lib:\n", - `file $lib`, "\n"; + error("Didn't understand `file` output for $lib:\n", + `file $lib`, "\n"); } elsif ($lib_type eq 'ELF') { $seen_ELF_lib = 1; @@ -490,17 +519,17 @@ if (@Libs) { } } -info 1, "\n"; +info(1, "\n"); if ($seen_ELF_lib) { # There's no official way to get the loader file, AFAIK. # This expression should get the latest version, and Yard will grab any # hard-linked file. my($ld_file) = (yard_glob("/lib/ld-linux.so.?"))[-1]; # Get last one if (defined($ld_file)) { - info 1, "Adding loader $ld_file for ELF libraries\n"; + info(1, "Adding loader $ld_file for ELF libraries\n"); include_file($ld_file); } else { - info 0, "Can't find ELF loader /lib/ld-linux.so.?"; + info(0, "Can't find ELF loader /lib/ld-linux.so.?"); } } if ($seen_AOUT_lib) { @@ -508,14 +537,14 @@ if ($seen_AOUT_lib) { # Same as above, but ld.so seems to have no version number appended. my($ld_file); foreach $ld_file (yard_glob("/lib/ld.so")) { - info 1, "Adding loader $ld_file for a.out libraries\n"; + info(1, "Adding loader $ld_file for a.out libraries\n"); include_file($ld_file); } } -info 0, "Done\n\n"; +info(0, "Done\n\n"); -info 0, "PASS 4: Recording hard links...\n"; +info(0, "PASS 4: Recording hard links...\n"); ##### Finally, scan all files for hard links. my(%hardlinked); @@ -533,10 +562,10 @@ foreach $file (keys %Included) { } } -info 0, "Done.\n\n"; +info(0, "Done.\n\n"); ############################################################################## -info 0, "Checking space needed.\n"; +info(0, "Checking space needed.\n"); my($total_bytes) = 0; my(%counted); @@ -547,7 +576,7 @@ foreach $file (keys %Included) { ##### Use the replacement file instead of this one. In the ##### future, improve this so that replacement is resolved WRT ##### %links_to - info 1, "Counting bytes of replacement $replacement\n"; + info(1, "Counting bytes of replacement $replacement\n"); $total_bytes += bytes_allocated($replacement); } elsif (-l $file or $links_to{$file}) { @@ -555,7 +584,7 @@ foreach $file (keys %Included) { ##### I don't think -l test is needed. my($size) = (-l $file) ? length(readlink($file)) : length($links_to{$file}); - info 1, "$file (link) size $size\n"; + info(1, "$file (link) size $size\n"); $total_bytes += $size; } elsif ($devino = $hardlinked{$file}) { @@ -563,16 +592,16 @@ foreach $file (keys %Included) { ##### know that the others are going to be in the file set. Count ##### the first and mark the dev/inode so we don't count it again. if (!$counted{$devino}) { - info 1, "Counting ", -s _, " bytes of hard-linked file $file\n"; + info(1, "Counting ", -s _, " bytes of hard-linked file $file\n"); $total_bytes += bytes_allocated($file); $counted{$devino} = 1; } else { - info 1, "Not counting bytes of hard-linked file $file\n"; + info(1, "Not counting bytes of hard-linked file $file\n"); } } elsif (-d $file) { - $total_bytes += $INODE_SIZE; - info 1, "Directory $file = ", $INODE_SIZE, " bytes\n"; + $total_bytes += $::INODE_SIZE; + info(1, "Directory $file = ", $::INODE_SIZE, " bytes\n"); } elsif ($file =~ m|^/proc/|) { ##### /proc files screw us up (eg, /proc/kcore), and there's no @@ -581,26 +610,26 @@ foreach $file (keys %Included) { } elsif (-f $file) { ##### Count space for plain files - info 1, "$file size ", -s _, "\n"; + info(1, "$file size ", -s _, "\n"); $total_bytes += bytes_allocated($file); } } # Libraries are already included in the count -info 0, "Total space needed is ", bytes_to_K($total_bytes), " Kbytes\n"; +info(0, "Total space needed is ", bytes_to_K($total_bytes), " Kbytes\n"); if (bytes_to_K($total_bytes) > $::fs_size) { - info 0, "This is more than $::fs_size Kbytes allowed.\n"; + info(0, "This is more than $::fs_size Kbytes allowed.\n"); if ($::strip_objfiles) { - info 0, "But since object files will be stripped, more space\n", - "may become available. Continuing...\n"; + info(0, "But since object files will be stripped, more space\n", + "may become available. Continuing...\n"); } else { - error "You need to trim some files out and try again.\n"; + error("You need to trim some files out and try again.\n"); } } -info 0, "\n"; +info(0, "\n"); ############################################################################## ##### Create filesystem @@ -609,7 +638,7 @@ sync(); sys("dd if=/dev/zero of=$::device bs=1k count=$::fs_size"); sync(); -info 0, "Creating ${::fs_size}K ext2 file system on $::device\n"; +#info(0, "Creating ${::fs_size}K ext2 file system on $::device\n"); if (-f $::device) { ##### If device is a plain file, it means we're using some loopback @@ -634,7 +663,7 @@ sync(); ##### First, create directories for symlink targets that are supposed ##### to be directories. Symlink targets can't be superseded so ##### sorting them by path length should give us a linear ordering. -info 0, "Creating directories for symlink targets\n"; +info(0, "Creating directories for symlink targets\n"); for $file (sort { path_length($a) <=> path_length($b) } keys %links_to) { @@ -644,7 +673,7 @@ for $file (sort { path_length($a) <=> path_length($b) } my($floppy_file) = $::mount_point . $abs_file; my($newdir); foreach $newdir (mkpath($floppy_file)) { - info 1, "\tCreating $newdir as a link target for $file\n"; + info(1, "\tCreating $newdir as a link target for $file\n"); } } } @@ -653,7 +682,7 @@ for $file (sort { path_length($a) <=> path_length($b) } ##### Next, set up actual symlinks, plus any directories that weren't ##### created in the first pass. Sorting by path length ensures that ##### parent symlinks get set up before child traversals. -info 0, "Creating symlinks and remaining directories.\n"; +info(0, "Creating symlinks and remaining directories.\n"); for $file (sort { path_length($a) <=> path_length($b) } keys %Included) { @@ -661,16 +690,16 @@ for $file (sort { path_length($a) <=> path_length($b) } if (defined($target = $links_to{$file})) { my($floppy_file) = $::mount_point . $file; mkpath(dirname($floppy_file)); - info 1, "\tLink\t$floppy_file -> $target\n"; + info(1, "\tLink\t$floppy_file -> $target\n"); symlink($target, $floppy_file) or - error "symlink($target, $floppy_file): $!\n"; + error("symlink($target, $floppy_file): $!\n"); delete $Included{$file}; # Get rid of it so next pass doesn't copy it } elsif (-d $file) { my($floppy_file) = $::mount_point . $file; my($newdir); foreach $newdir (mkpath($floppy_file)) { - info 1, "\tCreate\t$newdir\n"; + info(1, "\tCreate\t$newdir\n"); } delete $Included{$file}; # Get rid of it so next pass doesn't copy it } @@ -679,7 +708,7 @@ for $file (sort { path_length($a) <=> path_length($b) } ##### Tricky stuff is over with, now copy the remaining files. -info 0, "\nCopying files to $::device\n"; +info(0, "\nCopying files to $::device\n"); my(%copied); @@ -707,7 +736,7 @@ while (($file) = each %Included) { ##### on the root filesystem. if (defined($firstfile = $copied{$devino})) { ##### YES - just hard link it to existing file. - info 1, "Hard linking $floppy_file to $firstfile\n"; + info(1, "Hard linking $floppy_file to $firstfile\n"); sys("ln $firstfile $floppy_file"); next; # Skip copy @@ -716,23 +745,23 @@ while (($file) = each %Included) { $copied{$devino} = $floppy_file; } } - info 1, "$file -> $floppy_file\n"; + info(1, "$file -> $floppy_file\n"); copy_strip_file($file, $floppy_file); } elsif (-d $file) { ##### A directory. - info 1, "Creating directory $floppy_file\n"; + info(1, "Creating directory $floppy_file\n"); mkpath($floppy_file); } elsif ($file eq '/dev/null' and $floppy_file ne "$::mount_point/dev/null") { # I hate this - info 1, "Creating empty file $floppy_file\n"; + info(1, "Creating empty file $floppy_file\n"); mkpath(dirname($floppy_file)); sys("touch $floppy_file"); } else { ##### Some special file. - info 1, "Copying special $file to $floppy_file\n"; + info(1, "Copying special $file to $floppy_file\n"); mkpath(dirname($floppy_file)); # The 'R' flag here allows cp command to handle devices and FIFOs. sys("cp -dpR $file $floppy_file"); @@ -742,18 +771,18 @@ while (($file) = each %Included) { ############################################################################## -info 0, "\nFinished creating root filesystem.\n"; +info(0, "\nFinished creating root filesystem.\n"); if (@Libs) { - info 0, "Re-generating /etc/ld.so.cache on root fs.\n"; - info 1, "Ignore warnings about missing directories\n"; + info(0, "Re-generating /etc/ld.so.cache on root fs.\n"); + info(1, "Ignore warnings about missing directories\n"); sys("ldconfig -v -r $::mount_point"); } -info 0, "\nDone with $PROGRAM_NAME. $Warnings warnings.\n", - "$::device is still mounted on $::mount_point\n"; +info(0, "\nDone with $PROGRAM_NAME. $Warnings warnings.\n", + "$::device is still mounted on $::mount_point\n"); exit( $Warnings>0 ? -1 : 0); @@ -770,7 +799,7 @@ sub include_file { must_be_abs($file); if (onto_proc_filesystem($file)) { - info 1, "File $file points into proc filesystem -- not pursued.\n"; + info(1, "File $file points into proc filesystem -- not pursued.\n"); return; } @@ -786,26 +815,26 @@ sub include_file { ##### SYMBOLIC LINK on disk, not overridden by explicit link or ##### replacement. Relativize the link for use later, but also ##### check and resolve the target so it gets onto the rescue disk. - my($link) = readlink($file) or error "readlink($file): $!"; + my($link) = readlink($file) or error("readlink($file): $!"); my($rel_link) = make_link_relative($file, $link); $links_to{$file} = $rel_link; my($abs_target) = make_link_absolute($file, $link); if (onto_proc_filesystem($abs_target)) { - info 1, "$file points to $abs_target, on proc filesystem\n"; + info(1, "$file points to $abs_target, on proc filesystem\n"); last; } if (!$Included{$abs_target}) { - info 1, "File $file is a symbolic link to $link\n"; - info 1, "\t(which resolves to $abs_target),\n" - if $link ne $abs_target; - info 1, "\twhich was not included in $::contents_file.\n"; + info(1, "File $file is a symbolic link to $link\n"); + #info(1, "\t(which resolves to $abs_target),\n" + # if $link ne $abs_target); + info(1, "\twhich was not included in $::contents_file.\n"); if (-e $abs_target) { - info 1, "\t ==> Adding it to file set.\n\n"; + info(1, "\t ==> Adding it to file set.\n\n"); $Included{$abs_target} = $file; } else { - info 0, "\t ==> $abs_target does not exist. Fix this!\n"; + info(0, "\t ==> $abs_target does not exist. Fix this!\n"); } } $file = $abs_target; # For next iteration of while loop @@ -817,16 +846,16 @@ sub include_file { ##### More informative versions of warn and die, for the contents file sub cf_die { my($line, @msgs) = @_; - info 0, "$::contents_file($cf_line): $line\n"; - foreach (@msgs) { info 0, "\t$_\n"; } + info(0, "$::contents_file($cf_line): $line\n"); + foreach (@msgs) { info(0, "\t$_\n"); } exit; } sub cf_warn { my($line, @msgs) = @_; - info 0, "$::contents_file($cf_line): $line\n"; + info(0, "$::contents_file($cf_line): $line\n"); $Warnings++; - foreach (@msgs) { info 0, "\t$_\n"; } + foreach (@msgs) { info(0, "\t$_\n"); } } @@ -841,23 +870,23 @@ sub copy_strip_file { if (defined($lib_needed_by{$from})) { # It's a library - info 1, "Copy/stripping library $from to $to\n"; + info(1, "Copy/stripping library $from to $to\n"); sys("$objcopy --strip-all $from $to"); } elsif (defined($is_module{$from})) { - info 1, "Copy/stripping module $from to $to\n"; + info(1, "Copy/stripping module $from to $to\n"); sys("$objcopy --strip-debug $from $to"); } else { # It's a binary executable - info 1, "Copy/stripping binary executable $from to $to\n"; + info(1, "Copy/stripping binary executable $from to $to\n"); sys("$objcopy --strip-all $from $to"); } # Copy file perms and owner my($mode, $uid, $gid); (undef, undef, $mode, undef, $uid, $gid) = stat $from; - chown($uid, $gid, $to) or error "chown: $!"; - chmod($mode, $to) or error "chmod: $!"; + chown($uid, $gid, $to) or error("chown: $!"); + chmod($mode, $to) or error("chmod: $!"); } else { # Normal copy, no strip @@ -872,584 +901,6 @@ sub copy_strip_file { ############################################################## ############################################################## -############################################################################## -## -## CHECK_ROOT_FS -## -############################################################################## - -BEGIN { require "yard_utils.pl" } -require "Config.pl"; - -### 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"; - - -STDOUT->autoflush(1); - -start_logging_output(); -info 0, "check_root_fs @yard_version@\n"; - -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, "If this is acceptable, continue with write_rescue_disk\n"; -exit; - - -############################################################################## -sub warning { - info 0, "\n", @_; -# $Warnings++; -} - - -# This takes a procedure call, forks off a subprocess, chroots to -# $::mount_point and runs the procedure. -sub fork_chroot_and { - my($call) = @_; - - my($Godot) = fork; - die "Can't fork: $!" unless defined $Godot; - - if (!$Godot) { - # Child process - chdir($::mount_point); - chroot($::mount_point); ##### chroot to the root filesystem - &$call; - exit; - - } else { - # Parent here - waitpid($Godot, 0); - } -} - - -sub check_fstab { - my($FSTAB) = "/etc/fstab"; - my($proc_seen); - - open(FSTAB, "<$FSTAB") or error "$FSTAB: $!"; - info 0, "\nChecking $FSTAB\n"; - - while () { - chomp; - next if /^\#/ or /^\s*$/; - - my($dev, $mp, $type, $opts) = split; - next if $mp eq 'none' or $type eq 'swap'; - next if $dev eq 'none'; - - if (!-e $mp) { - info 0, "$FSTAB($.): $_\n\tCreating $mp on root filesystem\n"; - mkpath($mp); - } - - if ($dev !~ /:/ and !-e $dev) { - warning "$FSTAB($.): $_\n\tDevice $dev does not exist " - . "on root filesystem\n"; - } - - ##### If you use the file created by create_fstab, these tests - ##### are superfluous. - - if ($dev =~ m|^/dev/hd| and $opts !~ /noauto/) { - warning "\t($.): You probably should include \"noauto\" option\n", - "\tin the fstab entry of a hard disk. When the rescue floppy\n", - "\tboots, the \"mount -a\" will try to mount $dev\n"; - - } elsif ($dev eq $::floppy and $type ne 'ext2' and $type ne 'auto') { - warning "\t($.): You've declared your floppy drive $::floppy", - " to hold\n", - "\ta $type filesystem, which is not ext2. The rescue floppy\n", - "\tis ext2, which may confuse 'mount -a' during boot.\n"; - - } elsif ($type eq 'proc') { - $proc_seen = 1; - - } - } - close(FSTAB); - warning "\tNo /proc filesystem defined.\n" unless $proc_seen; - info 0, "Done with $FSTAB\n"; -} - - -sub check_inittab { - my($INITTAB) = "/etc/inittab"; - info 0, "\nChecking $INITTAB\n"; - - if (!open(INITTAB, "<$INITTAB")) { - warning "$INITTAB: $!\n"; - return - } - - my($default_rl, $saw_line_for_default_rl); - - while () { - chomp; - my($line) = $_; # Copy for errors - s/\#.*$//; # Delete comments - next if /^\s*$/; # Skip empty lines - - my($code, $runlevels, $action, $command) = split(':'); - - if ($action eq 'initdefault') { ##### The initdefault runlevel - $default_rl = $runlevels; - next; - } - if ($runlevels =~ /$default_rl/) { - $saw_line_for_default_rl = 1; - } - if ($command) { - my($exec, @args) = split(' ', $command); - - if (!-f $exec) { - warning "$INITTAB($.): $line\n", - "\t$exec: non-existent or non-executable\n"; - - } elsif (!-x $exec) { - info 0, "$INITTAB($.): $line\n", - info 0, "\tMaking $exec executable\n"; - chmod(0777, $exec) or error "chmod failed: $!"; - - } else { - ##### executable but not binary ==> script - scan_command_file($exec, @args) if !-B $exec; - } - - if ($exec =~ m|getty|) { # matches *getty* call - check_getty_type_call($exec, @args); - } - } - } - close(INITTAB) or error "close(INITTAB): $!"; - - if (!$saw_line_for_default_rl) { - warning "\tDefault runlevel is $default_rl, but no entry for it.\n"; - } - info 0, "Done with $INITTAB\n"; -} - - -##### This could be made much more complete, but for typical rc type -##### files it seems to catch the common problems. -sub scan_command_file { - my($cmdfile, @args) = @_; - my(%warned, $line); - - return if $checked{$cmdfile}; - info 0, "\nScanning $cmdfile\n"; - open(CMDFILE, "<$cmdfile") or error "$cmdfile: $!"; - - while ($line = ) { - chomp($line); - next if $line =~ /^\#/ or /^\s*$/; - - next if $line =~ /^\w+=/; - - while ($line =~ m!(/(usr|var|bin|sbin|etc|dev)/\S+)(\s|$)!g) { - my($abs_file) = $1; - # next if $abs_file =~ m/[*?]/; # Skip meta chars - we don't trust glob - next if $warned{$abs_file}; # Only warn once per file - if (!-e $abs_file) { - warning "$cmdfile($.): $line\n\t$1: missing on root filesystem\n"; - $warned{$abs_file} = 1; - } - } - } - close(CMDFILE) or error "close($cmdfile): $!"; - - $checked{$cmdfile} = 1; - info 0, "Done scanning $cmdfile\n"; -} - - -##### Check_passwd is NOT run under chroot. -sub check_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"; - - while () { - chomp; - next if /^\s*$/; # Skip blank/empty lines - my($line) = $_; - my($login_name, $passwd, $UID, $GID, $user_name, $home, $shell) = - split(':'); - - next if $passwd eq "*"; # Skip warnings if user can't login - - -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 - warning "$passwd_file($.): $line\n", - "\tShell of $login_name ($::mount_point$shell) doesn't exist\n"; - - check_init_files($login_name, $home, $shell); - } - close(PASSWD); - info 0, "Done checking $passwd_file\n"; -} - - -##### Simple PAM configuration checks. -##### Tests whether PAM is needed, and whether the configuration libraries exist. -##### Check_pam is NOT run under chroot. -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"; - - if (-e $pam_conf) { - info 0, "Checking $pam_conf\n"; - $pam_configured = 1; - open(PAM, $pam_conf) or error "Can't open pam.conf: $!\n"; - while () { - chomp; - next if /^\#/ or /^\s*$/; # Skip comments and empty lines - my($file) = (split)[3]; # Get fourth field - 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: $!"; - info 0, "Done with $pam_conf\n"; - } - - - if (-e $pamd_dir) { - info 0, "Checking files in $pamd_dir\n"; - opendir(PAMD, $pamd_dir) or error "Can't open $pamd_dir: $!"; - my($file); - while (defined($file = readdir(PAMD))) { - my($file2) = "$pamd_dir/$file"; - next unless -f $file2; # Skip directories, etc. - open(PF, $file2) or error "$file2: $!"; - while () { - chomp; - next if /^\#/ or /^\s*$/; # Skip comments and empty lines - my($file) = (split)[3]; # Get fourth field - $pam_configured = 1; - if (!-e "$::mount_point/$file") { - warning "$file2($.): $_\n", - "\tLibrary $file does not exist on root fs\n"; - } - } - close(PF); - } - closedir(PAMD); - } - - # Finally, see whether PAM configuration is needed - if (!$pam_configured and -e $login_binary) { - my($dependencies) = scalar(`ldd $login_binary`); - if (defined($dependencies) and $dependencies =~ /libpam/) { - warning "Warning: login ($login_binary) needs PAM, but you haven't\n", - "\tconfigured it (in /etc/pam.conf or /etc/pam.d/)\n", - "\tYou probably won't be able to login.\n"; - } - } - info 0, "Done with PAM\n"; -} - - - -##### Basic checks for nsswitch.conf. -##### check_nss is NOT run under chroot. -##### From the nsswitch.conf(5) manpage: -##### For glibc, you must have a file called /lib/libnss_SERVICE.so.X for -##### every SERVICE you are using. On a standard installation, you could -##### use `files', `db', `nis' and `nisplus'. For hosts, you could specify -##### `dns' as extra service, for passwd, group and shadow `compat'. These -##### services will not be used by libc5 with NYS. The version number X -##### is 1 for glibc 2.0 and 2 for glibc 2.1. - -sub check_nss { - 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_version) = $libc =~ m|/lib/libc-2.(\d)|; - if (!defined($libc_version)) { - warning "Can't determine your libc version\n"; - } else { - info 0, "You're using $libc\n"; - } - my($X) = $libc_version + 1; - - if (-e $nss_conf) { - open(NSS, "<$nss_conf") or die "open($nss_conf): $!"; - - my($line); - while (defined($line = )) { - chomp $line; - next if $line =~ /^\#/; - next if $line =~ /^\s*$/; - my($db, $entries) = $line =~ m/^(\w+):\s*(.+)$/; - # Remove bracketed expressions (action specifiers) - $entries =~ s/\[[^\]]*\]//g; - my(@entries) = split(' ', $entries); - my($entry); - for $entry (@entries) { - next if $entry =~ /^\[/; # ignore action specifiers - 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"; - } - } - } - - } else { - # No nsswitch.conf is present, figure out if maybe there should be one. - if (-e $login_binary) { - my($dependencies) = scalar(`ldd $login_binary`); - my($libc_version) = ($dependencies =~ /libc\.so\.(\d+)/m); - if ($libc_version > 5) { - # Needs libc 6 or greater - warning "Warning: $login_binary on rescue disk needs libc.so.$libc_version,\n" - . "\tbut there is no NSS configuration file ($nss_conf)\n" - . "\ton root filesystem.\n"; - } - } - } - info 0, "Done with NSS\n"; -} - - - -sub check_links { - 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); - - # 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 (!-e $target) { - warning "Warning: Unresolved link: $File::Find::name -> $raw_link\n"; - } - } - }; - - finddepth(\&wanted, $::mount_point); -} - - -sub chase_link { - my($file, $link_depth) = @_; - - if ($link_depth == 0) { - warning "Warning: Probable link circularity involving $file\n"; - - } elsif (-l $file) { - chase_link(make_link_absolute($file, readlink($file)), - $link_depth-1); - } -} - - -sub check_scripts { - info 0, "\nChecking script interpreters\n"; - local($prog); - - sub check_interpreter { - if (-x $File::Find::name and -f _ and -T _) { - open(SCRIPT, $File::Find::name) or error "$File::Find::name: $!"; - my($prog, $firstline); - chomp($firstline =