#! @PERL@
# -*- Mode: Perl -*-
# @configure_input@
# $Header: /usr/local/cvsroot/yard/scripts/check_root_fs.in,v 1.3 1998/05/23 13:41:30 fawcett Exp $
##############################################################################
##
##  CHECK_ROOT_FS
##  Copyright (C) 1996,1997,1998  Tom Fawcett (fawcett@croftj.net)
##
##  This program is free software; you can 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.
##------------------------------------------------------------
##
##############################################################################
use strict;
use File::Basename;
use File::Path;
use FileHandle;
use English;
use lib "@lib_dest@";
use yardconfig;
use File::Find;

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) = "$CFG::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
#  $CFG::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($CFG::mount_point);
      chroot($CFG::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 (<FSTAB>) {
      chomp;
      next if /^\#/ or /^\s*$/;

      my($dev, $mp, $type, $opts) = split;
      next if $mp eq 'none' or $type eq 'swap';

      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 $CFG::floppy and $type ne 'ext2') {
	  warning "\t($.): You've declared your floppy drive $CFG::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 (<INITTAB>) {
    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 = <CMDFILE>) {
    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) = "$CFG::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 (<PASSWD>) {
    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 ($CFG::mount_point . $home) or
      warning "$passwd_file($.): $line\n",
              "\tHome directory of $login_name ($CFG::mount_point$home) is missing\n";
    -e ($CFG::mount_point . $shell) or
      warning "$passwd_file($.): $line\n",
              "\tShell of $login_name ($CFG::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) = "$CFG::mount_point/etc/pam.d";
  my($pam_conf) = "$CFG::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 (<PAM>) {
      chomp;
      next if /^\#/ or /^\s*$/;          # Skip comments and empty lines
      my($file) = (split)[3];	# Get fourth field
      if (!-e "$CFG::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 (<PF>) {
	   chomp;
	   next if /^\#/ or /^\s*$/;           # Skip comments and empty lines
	   my($file) = (split)[3]; # Get fourth field
	   $pam_configured = 1;
	   if (!-e "$CFG::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.
sub check_nss {
   my($nss_conf) = "$CFG::mount_point/etc/nsswitch.conf";
   info 0, "Checking for NSS\n";

   if (-e $nss_conf) {
      open(NSS, "<$nss_conf")		or die "open($nss_conf): $!";
      
      my($line);
      while (defined($line = <NSS>)) {
	 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) = "$CFG::mount_point/lib/libnss_${entry}.so.1";
	    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 $CFG::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, $CFG::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 = <SCRIPT>);
      if (($prog) = $firstline =~ /^\#!\s*(\S+)/) {
	if (!-e $prog) {
	  warning "Warning: $File::Find::name needs $prog, which is missing\n";
	} elsif (!-x $prog) {
	  warning "Warning: $File::Find::name needs $prog, " . 
	      "which is not executable.\n";
	}
      }
      close(SCRIPT);
    }
  };				# End of sub check_interpreter

  find(\&check_interpreter, "/");
}  

sub check_getty_type_call {
  my($prog, @args) = @_;

  if ($prog eq 'getty') {
    my($tty, $speed, $type) = @args;

    if (!-e "$CFG::mount_point/dev/$tty") {
      warning "\tLine $.: $prog for $tty, but /dev/$tty doesn't exist.\n";
    }
    if (!defined($Termcap{$type})) {
      warning "\tLine $.: Type $type not defined in termcap\n";
    }
  }
  ##  If getty or getty_ps, look for /etc/gettydefs, /etc/issue
  ##  Check that term type matches one in termcap db.

  if ($prog =~ /^getty/) {
    if (!$checked_for_getty_files) {
      warning "\tLine $.: $prog expects /etc/gettydefs, which is missing.\n" 
	unless -e "$CFG::mount_point/etc/gettydefs";
      warning "\tLine $.: $prog expects /etc/issue, which is missing.\n"
	unless -e "$CFG::mount_point/etc/issue";
      $checked_for_getty_files = 1;
    }
  }
}


###
###  NB. This is *not* run under chroot
###
sub check_init_files {
    my($user, $home, $shell) = @_;

    info 0, "Checking init files of $user (homedir= $home)\n";

  my($shellname) = basename($shell);
  my @init_files;

  #####  Try to infer the list of init files to be run for the shell
  #####  of this user.  Order is somewhat important here because of
  #####  the search path.

  if ($shellname =~ /^(bash|sh)$/) {
    @init_files = ("/etc/profile", "/etc/bashrc", 
		   "$home/.profile", "$home/.bash_login", "$home/.bashrc",
		   "$home/.shrc");

  } elsif ($shellname eq "ash") {
    @init_files = ("/etc/profile", "$home/.profile");
	
  } elsif ($shellname =~ /^(tcsh|csh)$/) {
    @init_files = ("/etc/csh.cshrc", "/etc/.cshrc", "/etc/csh.login",
		   "$home/.cshrc", "$home/.tcshrc", "$home/.login");
  }

  #####  The path to be searched.  This may be error prone.
  my(@path) = ();
  my($init_file);

  foreach $init_file (@init_files) {
    $init_file = $CFG::mount_point . $init_file;
	
    next if $checked{$init_file} or !-r $init_file;
	
    info 0, "Checking $init_file\n";
	
    open(INITF, "<$init_file") 			or die "$init_file: $!";
	
    while (<INITF>) {
      chomp;
      next if /^\#/ or /^\s*$/;	  # Skip comments, whitespace
      
      my($var, $val);
      if (($var, $val) = /^\s*(\w+)\s*=\s*(.*)\s*$/) { # Variable assignment
	#####  Look for PATH assignment
	if ($var eq "PATH") {
	  $val =~ s/^[\"\'](.*)[\"\']$/$1/; # Strip quotes
	  @path = split(':', $val);
	  info 1, "Using PATH: ", join(':', @path), "\n";
	} else {
	  next;			# Skip other assignments
	}
      }
      
      my($cmd, $hd_abs);
      
      #####  Check for commands that aren't present
      ($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 "$CFG::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";
	}
      }
      
      #  Check for commands in backticks that aren't present
      ($cmd) = /\`(\w+)\b/;
      if ($cmd and ($hd_abs=find_file_in_path($cmd))) {
	#  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 "$CFG::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";
	}
      }
    }
    close(INITF);
    info 0, "Done with $init_file\n";
    $checked{$init_file} = 1;
  }			# end of foreach
}



sub check_termcap {
  open(TERMCAP, "<$CFG::mount_point/etc/termcap") or 
    warning "No file $CFG::mount_point/etc/termcap";
  while (<TERMCAP>) {
    chomp;
    next unless $_;
    next if /^\#/;		# Skip comments
    next if /^\s+/;		# Skip non-head lines

    #####  Get complete logical line
    my($def) = $_;
    while (/\\$/) {		# Trailing backslash => continued
      chomp($def);		# Discard backslash
      chomp($_ = <TERMCAP>);	# Get a line, w/o newline char
      $def .= $_;
    }

    #####  Extract terminal names from line
    my($names) = $def =~ /^([^:]+):/;
    my(@terms) = split(/\|/, $names);
    @Termcap{@terms} = (1) x ($#terms + 1);
  }
  close(TERMCAP);
}

#####  END OF CHECK_ROOT_FS
__END__
$Log: check_root_fs.in,v $
Revision 1.3  1998/05/23 13:41:30  fawcett
Dis-embedded 'if (my(...' to accomodate 5.002

Revision 1.2  1998/02/21 13:40:10  fawcett
tentative commit.