#! @PERL@
# -*- Mode: Perl -*-
# @configure_input@
# $Header: /usr/local/cvsroot/yard/scripts/make_root_fs.in,v 1.4 1998/05/27 20:03:55 fawcett Exp $
##############################################################################
##
##  MAKE_ROOT_FS
##  Copyright (C) 1996,1997,1998  Tom Fawcett (fawcett@croftj.net)
##
##  This program is free software; you may redistribute it and/or modify
##  it under the terms of the GNU General Public License as published by
##  the Free Software Foundation; either version 2 of the License, or
##  (at your option) any later version.
##
##  This program is distributed in the hope that it will be useful,
##  but WITHOUT ANY WARRANTY; without even the implied warranty of
##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
##  GNU General Public License for more details.
##
##  You should have received a copy of the GNU General Public License
##  along with this program; if not, write to the Free Software
##  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
##
#####
##
##  This is the first script of the Yard suite for creating custom 
##  rescue disks. 
##############################################################################
use strict;
use File::Basename;
use File::Path;
use FileHandle;
use Cwd;
use English;
use lib "@lib_dest@";
use yardconfig;

BEGIN { require "yard_utils.pl"; }
require "Config.pl";

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

my($Warnings) = 0;
sub warning {
  info 0, "Warning: ", @_;
  $Warnings++;
}

##############################################################################
#####  Check some basic things before starting.
#####  There's probably a more graceful way to maintain and check
#####  a set of user options (via a Perl module), but I'm too lazy
#####  to track it down.
##############################################################################
$REAL_USER_ID == 0 or error "This script must be run as root\n";

if (!defined($CFG::device) and !defined($CFG::mount_point)) {
  error "Nothing defined in CFG package.  You probably just copied\n",
        "an old Config.pl file.\n";
}

#  Check mount point
if (-d $CFG::mount_point and -w _) {
  info 1, "Using $CFG::mount_point as mount point for $CFG::device\n";
} else {
  error "Mount point $CFG::mount_point must be a directory and\n",
        "must be write-enabled.\n";
}

#  Check for sane device choice before we start using it.
check_device();

#  Make sure $CFG::device isn't already mounted and $CFG::mount_point is free
load_mount_info();

if (defined($::mounted{$CFG::device})) {

  if ($::mounted{$CFG::device} eq $CFG::mount_point) {
    info 1, "Device $CFG::device is already mounted on $CFG::mount_point\n";
    info 1, "Unmounting it automatically.\n";
    sys("umount $CFG::mount_point");

  } else {
    error "$CFG::device is already mounted elsewhere (on $::mounted{$CFG::device})\n",
          "Unmount it first.\n";
  }

} elsif (defined($::mounted{$CFG::mount_point})) {
  error "Some other device is already mounted on $CFG::mount_point\n";
}

#  Have to test this every time so we can work around.
test_glob();

#####  Determine release of $CFG::kernel for modules.
#####  Set RELEASE environment variable for use in contents.
if (defined($CFG::kernel_version)) {
   #  Check to see if it agrees
   my($version_guess) = kernel_version($CFG::kernel);
   if ($version_guess ne $CFG::kernel_version) {
      info 0, "You declared kernel ($CFG::kernel) to be version $CFG::kernel_version,\n",
      "\teven though a probe says $version_guess.",
      "\tI'll assume you're right.\n";
   }
  $ENV{'RELEASE'} = $CFG::kernel_version;

} elsif (defined($ENV{'RELEASE'} = kernel_version($CFG::kernel))) {
  info 0, "Probe of $CFG::kernel returns version $ENV{'RELEASE'}\n";

} else {
  warning "Can't determine kernel version of $CFG::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";
    $ENV{'RELEASE'} = $release;
  } else {
    error "And can't determine running kernel's version either!\n";
  }
}

warn_about_module_dependencies($ENV{'RELEASE'});

if ($CFG::disk_set !~ /^(single|double|base\+extra)$/) {
  error "Config variable disk_set is set to \"$CFG::disk_set\"\n",
        "which is not a valid value.\n";
}

##############################################################################
#####  READ IN CONTENTS FILE                                             #####
##############################################################################
my($contents_file) = resolve_file($CFG::contents_file);
info 0, "\n\nPASS 1:  Reading $CFG::contents_file";
info 0, " ($contents_file)" if $contents_file ne $CFG::contents_file;
info 0, "\n";

my(%Included);
my(%replaced_by);
my(%links_to);
my(%is_module);

open(CONTENTS, "<$contents_file") or error "$contents_file: $!";

my($cf_line) = 0;
my($line);

LINE: while (defined($line = <CONTENTS>)) {
  my(@files);
  $cf_line++;
  chomp $line;
  $line =~ s/[\#%].*$//;	# Kill comments
  next if $line =~ /^\s*$/;	# Ignore blank/empty line
    
  $line =~ s/^\s+//;		# Delete leading/trailing whitespace
  $line =~ s/\s+$//;
    
#  if ($line =~ /\$RELEASE/) {
#    cf_warn($line, "Make sure \$RELEASE ($ENV{'RELEASE'}) is correct " .
#	           "for $CFG::kernel");
#    }
    
  if ($line =~ /->/) {	#####  EXPLICIT LINK
    if ($line =~ /[\*\?\[]/) {
      cf_warn($line, "Can't use wildcards in link specification!");
      next LINE;
    }
    my($file, $link) = $line =~ /^(\S+)\s*->\s*(\S+)\s*$/;
    if (!defined($link)) {
      cf_warn($line, "Can't parse this link");
      next LINE;
    }
    #####  The '->' supersedes file structure on the disk, so don't
    #####  call include_file until pass two after all explicit links
    #####  have been seen.
    my($abs_file) = find_file_in_path($file);
    $Included{$abs_file} = 1;
    ####   Have to be careful here.  Record the rel link for use
    ####   in setting up the root fs, but use the abs_link in @files 
    ####   so next loop gets any actual files.
    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";
    @files = ($abs_link);
	
  } elsif ($line =~ /<=/) {	#####  REPLACEMENT SPEC 
    cf_die($line, "Can't use wildcard in replacement specification") if
	$line =~ /[\*\?\[]/;
	
    my($file, $replacement) = $line =~ /^(\S+)\s*<=\s*(\S+)\s*$/;
	
    if (!defined($replacement)) {
      cf_warn($line, "Can't parse this replacement spec");
      next LINE;
	    
    } else {
      must_be_abs($file);
      (-d $file) and cf_warn($line, "left-hand side can't be directory");
      my($abs_replacement) = find_file_in_path($replacement);
      if (!(defined($abs_replacement) and -e $abs_replacement)) {
	cf_warn($line, "Can't find $replacement");

      } elsif ($replacement =~ m|^/dev/(?!null)|) {
	#  Allow /dev/null but no other devices
	cf_warn($line, "Can't replace a file with a device");

      } else {
	$replaced_by{$file} = $abs_replacement;
	$Included{$file} = 1;
      }
	    
      next LINE;
    }			#  End of replacement spec
	
  } elsif ($line =~ /(<-|=>)/) {
    cf_warn($line, "Not a valid arrow.");
    next LINE;
	
  } else {
	
    @files = ();
    my($expr);
    for $expr (split(' ', $line)) {
      my(@globbed) = yard_glob($expr);
      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";
      }
      push(@files, @globbed);
    }
  }
    
  my($file);
 FILE: foreach $file (@files) {
	
    if ($file =~ m|^/|) {	#####  Absolute filename
	    
      if (-l $file and readlink($file) =~ m|^/proc/|) {
	info 1, "Recording proc link $file -> ", readlink($file), "\n";
	$Included{$file} = 1;
	$links_to{$file} = readlink($file);
	
      } elsif (-e $file) {
		
	$Included{$file} = 1;
		
      } elsif ($file =~ m|^$CFG::oldroot/(.*)$|o and -e "/$1") {
	### Don't complain about links to files that will be mounted
	### under $oldroot, the hard disk root mount point.
	next FILE;

      } else {
	cf_warn($line, "Absolute filename $file doesn't exist");
      }
	    
    } else {		##### Relative filename
      my($abs_file) = find_file_in_path($file);
      if ($abs_file) {
	info 1, "Found $file at $abs_file\n";
	$Included{$abs_file} = 1;
      } else {
	cf_warn($line, "Didn't find $file anywhere in path");
      }
    }
  }				# End of FILE loop
}				# End of LINE loop

info 0, "\nDone with $contents_file\n\n";

if ($CFG::disk_set eq "base+extra") {
  include_file(find_file_in_path("tar"))
}

close(CONTENTS) or error("close on $contents_file: $!");


##############################################################################
info 0, "\n\nPASS 2:  Picking up extra files from links...\n";

for (keys %Included) {
  include_file($_);
}

info 0, "Done.\n\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
#  X <= Y:  X in %Included and %replaced_by

my(%strippable);
my(%lib_needed_by);

my($file);
foreach $file (keys %Included) {
    
  ##### Use replacement file if specified
  $file = $replaced_by{$file} if defined($replaced_by{$file});
    
  ##### Skip links (target will be checked)
  next if defined($links_to{$file}); # Symbolic (declared)
  next if -l $file;		     # Symbolic (on disk)
    
  my($file_line) = `file $file`;
  #####  See whether it's strippable and make a note.
  #####  This will prevent us from wasting time later running objcopy
  #####  on binaries that are already stripped.
  if ($file_line =~ m/not stripped/) {
     $strippable{$file} = 1;
  }
  #####  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";
     $is_module{$file} = 1;

  } elsif ($file_line =~ m/shared object/) {
     #####  Any library (shared object) seen here was explicitly included
     #####  by the user.
  
     push(@{$lib_needed_by{$file}}, "INCLUDED BY USER");
  }
    
  if (-f $file and -B _ and -x _ and $file_line =~ /executable/) {
	
    #####  EXECUTABLE LOADABLE BINARY
    #####  Run ldd to get library dependencies.
    foreach $line (`ldd $file`) {
      my($lib) = $line =~ / => (\S+)/;
      next unless $lib;
      my($abs_lib) = $lib;
	    
      if ($lib =~ /not found/) {
	warning "File $file needs library $lib, which does not exist!";
      } else {
		
	#####  Right-hand side of the ldd output may be a symbolic link.
	#####  Resolve the lib absolutely.
	#####  include_file follows links and adds each file; 
	#####  the while loop makes sure we get the last.
	$abs_lib = $lib;
	include_file($lib);
	while (1) {
	  if (defined($links_to{$abs_lib})) {
	    $abs_lib = make_link_absolute($abs_lib,
					  $links_to{$abs_lib});
	  }
	  if (defined($replaced_by{$abs_lib})) {
	    $abs_lib = $replaced_by{$abs_lib};
	  }
	  last unless -l $abs_lib;
	  my($link) = readlink($abs_lib) or
	      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";
      }
      push(@{$lib_needed_by{$abs_lib}}, $file);
    }
  }
}

##############################################################################
#####  Check libraries and loader(s)                                     #####
##############################################################################
my(@Libs) = keys %lib_needed_by;

my($seen_ELF_lib, $seen_AOUT_lib);
my(%full_name);

if (@Libs) {
    info 1, "\nYou need these libraries:\n";
  
    my($lib);
    foreach $lib (@Libs) {
	my($size)      = bytes_to_K(-s $lib);
	my($line)      = " " x 15;
	my($file_output) = `file $lib`;

	if ($file_output =~ m/symbolic link/) {
	  error "Yiiiiii, library file $lib is a symbolic link!\n",
	        "This shouldn't happen!\n",
	        "Please report this error to the Yard author\n";
	}

	my($lib_type)  = $file_output =~ /:\s*(ELF|Linux)/m;
	
	#####  All libraries are strippable
	$strippable{$lib} = 1;

	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";
		$line = " " x 15;
	    }
	    $line .= $binary . " ";
	}
	info 1, $line, "\n" if $line;
	
	if (!($seen_ELF_lib and $seen_AOUT_lib)) {
	    
	    #####  Check library to make sure we have the right loader.
	    #####  (A better way is to do "ldconfig -p" and parse the output)
	    #####  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";
		
	    } elsif ($lib_type eq 'ELF') {
		$seen_ELF_lib = 1;
		
	    } elsif ($lib_type eq 'Linux') { # ie, a.out
		$seen_AOUT_lib = 1;
	    }
	}

	#####  See if some other version of this library file is 
	#####  being loaded, eg libc.so.3.1.2 and libc.so.5.2.18.
	#####  Not an error, but worth warning the user about.

	my($lib_stem) = basename($lib) =~ /^(.*?\.so)/;
	if (defined($full_name{$lib_stem})) {
	    warning "You need both $lib and $full_name{$lib_stem}\n",
	            "Check log file for details.\n";
	} else {
	    #####  eg, $full_name{"libc.so"} = "/lib/libc.so.5.2.18"
	    $full_name{$lib_stem} = $lib;
	}
    }
}

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";
     include_file($ld_file);
  } else {
     info 0, "Can't find ELF loader /lib/ld-linux.so.?";
  }
}
if ($seen_AOUT_lib) {
  #  Was: yard_glob("/lib/ld.so*")
  #  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";
    include_file($ld_file);
  }
}

info 0, "Done\n\n";	 

info 0, "PASS 4:  Recording hard links...\n";

#####  Finally, scan all files for hard links.
my(%hardlinked);
foreach $file (keys %Included) {
    
    next if $links_to{$file} or $replaced_by{$file};
    #####  $file is guaranteed to be absolute and not symbolically linked.
    
    #####  Record hard links on plain files
    if (-f $file) {
	my($dev, $inode, $mode, $nlink) = stat(_);
	if ($nlink > 1) {
	    $hardlinked{$file} = "$dev/$inode";
	}
    }
}

info 0, "Done.\n\n";

##############################################################################
info 0, "Checking space needed.\n";
my($total_bytes) = 0;
my(%counted);

foreach $file (keys %Included) {
   
   my($replacement, $devino);
   if ($replacement = $replaced_by{$file}) {
      #####  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";
      $total_bytes += bytes_allocated($replacement);
      
   } elsif (-l $file or $links_to{$file}) {
      #####  Implicit or explicit symbolic link.  Only count link size.
      #####  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";
     $total_bytes += $size;
      
   } elsif ($devino = $hardlinked{$file}) {
      #####  This file is hard-linked to another.  We don't necessarily
      #####  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";
	 $total_bytes += bytes_allocated($file);
	 $counted{$devino} = 1;
      } else {
	 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";

   } elsif ($file =~ m|^/proc/|) {
      #####  /proc files screw us up (eg, /proc/kcore), and there's no
      #####  Perl file test that will detect them otherwise.
      next;
      
   } elsif (-f $file) {
      #####  Count space for plain files
      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";

if (bytes_to_K($total_bytes) > $CFG::fs_size) {
    info 0, "This is more than $CFG::fs_size Kbytes allowed.\n";
    if ($CFG::strip_objfiles) {
	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";
    }
}

info 0, "\n";

##############################################################################
#####  Create filesystem
##############################################################################
sync();
sys("dd if=/dev/zero of=$CFG::device bs=1k count=$CFG::fs_size");
sync();

info 0, "Creating ${CFG::fs_size}K ext2 file system on $CFG::device\n";

if (-f $CFG::device) {
    #####  If device is a plain file, it means we're using some loopback 
    #####  device.  Use -F switch in mke2fs so it won't complain.
    sys("mke2fs -F -m 0 -b 1024 $CFG::device $CFG::fs_size");
} else {
    sys("mke2fs -m 0 -b 1024 $CFG::device $CFG::fs_size");
}

&mount_device;
##### lost+found on a ramdisk is pointless
sys("rm -rf $CFG::mount_point/lost+found");

sync();


#####  Setting up the file structure is tricky.  Given a tangled set
#####  of symbolic links and directories, we have to create the
#####  directories, symlinks and files in the right order so that no
#####  dependencies are missed.

#####  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";

for $file (sort { path_length($a) <=> path_length($b) }
		  keys %links_to) {
  my($link_target) = $links_to{$file};
  my($abs_file) = make_link_absolute($file, $link_target);
  if (-d $abs_file) {
    my($floppy_file) = $CFG::mount_point . $abs_file;
    my($newdir);
    foreach $newdir (mkpath($floppy_file)) {
      info 1, "\tCreating $newdir as a link target for $file\n";
    }
  }
}


#####  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";
for $file (sort { path_length($a) <=> path_length($b) }
	   keys %Included) {
  
  my($target);
  if (defined($target = $links_to{$file})) {
    my($floppy_file) = $CFG::mount_point . $file;
    mkpath(dirname($floppy_file));
    info 1, "\tLink\t$floppy_file -> $target\n";
    symlink($target, $floppy_file) or
	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) = $CFG::mount_point . $file;
    my($newdir);
    foreach $newdir (mkpath($floppy_file)) {
      info 1, "\tCreate\t$newdir\n";
    }
    delete $Included{$file}; # Get rid of it so next pass doesn't copy it
  }	
}


#####  Tricky stuff is over with, now copy the remaining files.

info 0, "\nCopying files to $CFG::device\n";

my(%copied);

my($file);
while (($file) = each %Included) {
  my($floppy_file) = $CFG::mount_point . $file;
    
  my($replacement);
  if (defined($replacement = $replaced_by{$file})) {
    $file = $replacement;
  }
    
  if ($file =~ m|^/proc/|) {
    #####  Ignore /proc files 
    next;
    
  } elsif (-f $file) {
    #####  A normal file.  
    mkpath(dirname($floppy_file));
	
    #####  Maybe a hard link.
    my($devino, $firstfile);
    if (defined($devino = $hardlinked{$file})) {
      #####  It's a hard link - see if the linked file is already
      #####  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";
	sys("ln $firstfile $floppy_file");
	next;		# Skip copy
	
      } else {
	#####  NO - copy it.
	$copied{$devino} = $floppy_file;
      }
    }
    info 1, "$file -> $floppy_file\n";
    copy_strip_file($file, $floppy_file);
    
  } elsif (-d $file) {
    #####  A directory.
    info 1, "Creating directory $floppy_file\n";
    mkpath($floppy_file);
    
  } elsif ($file eq '/dev/null' and 
	   $floppy_file ne "$CFG::mount_point/dev/null") { # I hate this
    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";
    mkpath(dirname($floppy_file));
    #  The added 'R' flag here, for some reason, allows this cp command
    #  to handle FIFO's.
    sys("cp -dpR $file $floppy_file");
  }
}


##############################################################################

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 1, "If next message is from execvp, it means you moved ldconfig\n";
  sys("cd $CFG::mount_point; chroot $CFG::mount_point ldconfig -v");
}

info 0, "\nDone with $PROGRAM_NAME.  $Warnings warnings.\n",
        "$CFG::device is still mounted on $CFG::mount_point\n";

exit( $Warnings>0 ? -1 : 0);


#############################################################################
#####  Utility subs for make_root_fs.pl
#############################################################################

#####  Add file to the file set.  File has to be an absolute filename.
#####  If file is a symlink, add it and chase the link(s) until a file is
#####  reached.
sub include_file {
    my($file) = @_;
    
    must_be_abs($file);
    if (onto_proc_filesystem($file)) {
	info 1, "File $file points into proc filesystem -- not pursued.\n";
	return;
    }
    
    $Included{$file} = 1;
    
    #####  If we have links   A -> B -> C -> D -> E 
    #####  on disk and   A -> D  is set explicitly, then we pick up
    #####  files A and D in pass 1, and E on pass 2.
    
    while (!defined($links_to{$file}) and !defined($replaced_by{$file})
	   and -l $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($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";
	    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 $CFG::contents_file.\n";
	    if (-e $abs_target) {
		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";
	    }
	}
	$file = $abs_target;	# For next iteration of while loop
    }
}



#####  More informative versions of warn and die, for the contents file
sub cf_die {
  my($line, @msgs) = @_;
  info 0, "$CFG::contents_file($cf_line): $line\n";
  foreach (@msgs) { info 0, "\t$_\n"; }
  exit;
}

sub cf_warn {
  my($line, @msgs) = @_;
  info 0, "$CFG::contents_file($cf_line): $line\n";
  $Warnings++;
  foreach (@msgs) { info 0, "\t$_\n"; }
}


#  Copy a file, possibly stripping it.  Stripping is done if the file
#  is strippable and stripping is desired by the user, and if the
#  objcopy program exists.
sub copy_strip_file {
    my($from, $to) = @_;
    
    if ($CFG::strip_objfiles and defined($objcopy) and $strippable{$from}) {
	#  Copy it stripped

	if (defined($lib_needed_by{$from})) {
	    #  It's a library
	    info 1, "Copy/stripping library $from to $to\n";
	    sys("$objcopy --strip-debug $from $to");

	} elsif (defined($is_module{$from})) {
	    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";
	    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: $!";

    } else {
	#  Normal copy, no strip
	sys("cp $from $to");
    }
}


#####  End of make_root_fs
__END__
$Log: make_root_fs.in,v $
Revision 1.4  1998/05/27 20:03:55  fawcett
Changed so that yard only squawks about kernel versions if the
internal probe disagrees with the user setting of $CFG::kernel_version.

Revision 1.3  1998/05/27 19:57:54  fawcett
warn_about_module_dependencies now takes an argument.

Revision 1.2  1998/05/23 13:39:28  fawcett
Removed 'while (my($file)...) ' to accomodate 5.002