#! /usr/bin/perl 
# -*- Mode: Perl -*-
# This script created automatically from scripts/check_root_fs.in
# $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 "/etc/yard", "/usr/share/yard";
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 2.2\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);

   info 0, "\nChecking $FSTAB\n";
   if (!open(FSTAB, $FSTAB)) {
      warning "/etc/fstab missing on root filesystem.\n";
      return;
   }

   while (<FSTAB>) {
      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 $CFG::floppy and $type ne 'ext2' and $type ne 'auto') {
	 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(':');

    # Skip warnings if user can't login
    next if $passwd eq "*" or $passwd eq "x";

    -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.
#####  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.
#####
#####  (I'll assume X=2 for glibc 2.2 as well, since that seems to be the case.)

sub check_nss {
   my($nss_conf) = "$CFG::mount_point/etc/nsswitch.conf";
   info 0, "Checking for NSS\n";

   my($libc) = yard_glob("$CFG::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 == 0 ? 1 : 2);

   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.${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 $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) = @_;

   #  If $home doesn't exist we've already warned about it
   #  when checking /etc/passwd, so return silently.
   return unless -e "$CFG::mount_point/$home";
   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 {
   if (!open(TERMCAP, "<$CFG::mount_point/etc/termcap")) {
      warning "No file $CFG::mount_point/etc/termcap\n";
      return;
   }
   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
