#!/usr/bin/perl

=pod

=head1 NAME

B<CHECKRPMS> - automated status report about RPMs on a system

=head1 SYNOPSIS

./B<CHECKRPMS> [I<modeflag>]

or

B<perl> B<CHECKRPMS> [I<modeflag>]

If I<modeflag> is left blank, the mode is "interactive".  Otherwise,
other modes can be specified as shown in the listing below:

=over 4

=item DEFAULT

When left blank, the script runs in interactive mode.  First, a proposed
list of RPMs is presented to the user.  Then, the user is asked if he or
she wants to download the RPMs to /tmp/loncapa_rpm_updates/.

=item view

A proposed list of RPMs to update is presented to the user.

=item download

A proposed set of RPMs to update are downloaded into /tmp/loncapa_rpm_updates/.
Note that prior information inside /tmp/loncapa_rpm_updates/ is removed.

=item redownload

A proposed set of RPMs to update are downloaded into /tmp/loncapa_rpm_updates/.
Note that prior information inside /tmp/loncapa_rpm_updates/ is not removed.
(This helps support continual attempts from dialup connections.)

=item html

Similar to view mode. XHTML-formatted output is delivered; presumably
to a web client.  html mode is automatically chosen if $ENV{'QUERY_STRING'} is
defined.

=back

=head1 DESCRIPTION

This file automates the usage of Martin Siegert's "check-rpms"
script.  It runs through a list of possible mirror sites
until it finds one with a reasonably good FTP connection.

For instructions on usage, see L<SYNOPSIS>.

=head1 AUTHOR

Scott Harrison, sharrison@users.sourceforge.net, 2002

=cut

# ================================================== READ IN COMMAND ARGUMENTS.

# ---------------------------------------------------- Process download option.
my $argument = shift(@ARGV);
my $document;
my $mode;
if ($argument eq '--download' or $argument eq '--redownload')
  {
    if ($< != 0) # Download mode requires 'root'.
      {
        print(
	      '**** ERROR **** Download mode needs to be run as root'."\n");
	exit(0); # Exit.
      }
    `rm -Rf /tmp/loncapa_rpm_updates` if $argument eq '--download';
    $download='-v -dl -d /tmp/loncapa_rpm_updates'; # Part of check-rpms args.
    $mode = 'download';
  }
elsif ($argument eq '--view')
  {
    $mode = 'view';
  }
elsif ($argument eq '--cronmail')
  {
    $mode = 'cronmail';
  }
elsif ($ENV{'QUERY_STRING'} or $argument eq '--html')
  {
    $mode = 'html';
  }
else
  {
    $mode = 'interactive';
  }

# ================================================== GENERAL INITIAL VARIABLES.
my $command_name=$0;

# ---------------- The FTP servers (and their directory paths) to check against
my @serverpaths_to_try = 
  (
    'ftpmirror:loncapa@install.lon-capa.org/pub/redhat/linux/updates/',
    'mirror.pa.msu.edu/linux/redhat/linux/updates/',
    'distro.ibiblio.org/pub/linux/distributions/redhat/updates/',
    'limestone.uoregon.edu/redhat/updates/',
    'rufus.w3.org/linux/redhat/linux/updates/',
  );

# -------------------------------------------- Use check-rpms command this way.
my $checkcommand = 'check-rpms '.$download.' --rpmuser www -ftp';

my $FTPSERVER; # ------------------------- the server portion of the serverpath
my $FTPUPDATES; # ----------------------------- the actual update root location
my @rpms; # ---------------------------------- this will store the list of RPMs
my $goodoutput; # ------------------------------------ good stuff was returned!
my $reallygoodoutput; # ------------------------------- you are 100% up-to-date

# ===================================================== Control flow of output.
my $out = \*STDOUT; # Default: go to standard output (directly to terminal).

if ($mode eq 'cronmail') # If cronmail mode, then save to file.
  {
    open(FOUT,'>/tmp/CHECKRPMS.'.$$);
    $out = \*FOUT;
  }

$| = 1; # Flush to output whenever possible.

# ========================================== Variables that must be defineable.

# --------------------------------------------------- Determine RedHat version.
my $RHversion = (split /\s/, `cat /etc/redhat-release`)[4]; # - 6.2 or 7.3 or ?

unless ($RHversion)
  {
    terminate($mode,$out,
	      '**** ERROR **** /etc/redhat-release not found'."\n".
	      'This script does not appear to be running on RedHat.'."\n");
  }

# ----------------------------------------- Find the check-rpms script location
if (-e './check-rpms')
  {
    $commandpre='perl ./'; # Use the check-rpms in the current directory.
  }
elsif (-e 'loncom/build/check-rpms')
  {
    $commandpre='perl loncom/build/'; # Use check-rpms in the loncom/build dir.
  }
elsif (-e '/usr/local/loncapa/bin/check-rpms')
  {
    $commandpre='perl /usr/local/loncapa/bin/'; # Use /usr/local dir.
  }
else # Cannot find check-rpms, so abort.
  {
    terminate($mode,$out,
	      '**** ERROR **** CANNOT FIND THE check-rpms SCRIPT'."\n");
  }

# Define check-rpms invocation based on the path to the check-rpms command.
$checkcommand = $commandpre.$checkcommand;

# ============================================================= Initial output.

print($out <<END) if $mode eq 'html';
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"></meta>
<title>CHECKRPMS STATUS REPORT</title>
</head>
<body bgcolor="white">
<h1>CHECKRPMS STATUS REPORT</h1>
<hr />
<pre>
END

# Notify user of current action.
print($out <<END);
THIS SCRIPT IS NOW PROBING SEVERAL FTP SERVERS....
PLEASE BE PATIENT, THIS MAY TAKE A FEW MINUTES.
END

# ============== Go through all the servers until a decent connection is found.
SERVERLOOP: foreach my $serverpath (@serverpaths_to_try)
  {
    $serverpath=~/^(.*?)\//; # Pattern match the ip name.
    $FTPSERVER=$1; # Set to the ip name.
    $FTPSERVER_noauth=$FTPSERVER;
    $FTPSERVER_noauth=~s/^.*?\@//;
    print($out
	  "Trying $FTPSERVER_noauth...\n"); # Notify of attempts with ip name.
    `ping -c 1 -w 10 $FTPSERVER_noauth 2>/dev/null`;#Ping ftp server (u there?)
    if ($?==0) # If the ftp server can be pinged.
      {
	print($out "$FTPSERVER found...\n"); # Tell user ftp server is found.
	`ncftpls ftp://$FTPSERVER`; # Try to access server with ftp protocol.
	if ($?==0) # If the ftp server can be accessed with the ftp protocol.
          {
	    $FTPUPDATES="$serverpath$RHversion/en/os"; # The full update path.
	    # Print the check-rpms command that will be executed.
	    print($out $checkcommand.' '.$FTPUPDATES."\n");
	    if ($mode eq 'download') # Was CHECKRPMS run in download mode?
              {
		$|=1; # Try to send things immediately to stdout; err umm....
		# Tell the user about the /tmp/loncapa_rpm_updates directory.
		print($out '**** NOTE **** '.
		      'To check the status of the download, you can '.
		      'periodically inspect the contents of the '.
		      '/tmp/loncapa_rpm_updates directory.  '.
		      'Please be patient; this download may take a while.'.
		      "\n");
		# Do the download.
		print($out `$checkcommand $FTPUPDATES 2>\&1`);
		# Tell the user about what action they need to take with the
		# downloaded RPMs.
		print($out
		      'You may now wish to visit the /tmp/loncapa_rpm_updates'.
		      ' directory and upgrade the RPMs.  '."\n".
		      'If this is a critical server (it is currently being'.
		      ' used for classes) and you do not know how to upgrade'.
		      ' RPMs, you should consult someone who has experience '.
		      'with the "rpm" command.'."\n");
		clean_exit($mode,$out,0); # Assume everything is okay and exit.
	      }
	    @rpms=`$checkcommand $FTPUPDATES 2>\&1`; # Read in list of RPMs.
	    # Create a text string that can be pattern matched.
	    my $rpmtext=join('',@rpms);
	    if ($rpmtext=~/You do not seem to have a/) # No www?
              {
		print($out "You do not have a 'www' user on your system.\n".
		      "Please add this user and try this command again.\n");
		clean_exit($mode,$out,0);
	      }
	    if ($rpmtext=~/This account is currently not/) # ------------ uh-oh
	      {
		print($out "...strange error, moving on ($FTPSERVER)\n");
	      }
	    else # --------------------------------------- the output is "good"
	      {
		$goodoutput=$rpmtext;
		unless (@rpms) # If there are no RPMs to update.
		  {
		    $reallygoodoutput = <<END;
**** NOTE **** All RPMS on your system appear to be up to date.
END
                    $goodoutput = ' ';
		  }
		last SERVERLOOP;
	      }
	  }
	print($out '...cannot establish an ftp session with '.$FTPSERVER."\n");
      }
    else
      {
	print($out "...cannot find $FTPSERVER on the network\n");
      }
  }
if (!$goodoutput) # If never received any useable output, assume "no server".
  {
    print($out '**** ERROR **** Cannot find a working ftp server.'."\n");
    clean_exit($mode,$out,0);
  }
elsif ($reallygoodoutput) # Everything is peachy keen and up-to-date already.
  {
    print($out $reallygoodoutput);
  }
else # There are RPMs that need to be updated; show list to user.
  {
    my $rpmcount=scalar(@rpms); # Count up size of RPM list.
    print($out <<END); # Print out an advisory warning to user.
**** WARNING **** You need to update at least $rpmcount RPMS shown in
the list below.  THIS IS IMPORTANT FOR SECURITY.

END
    print($out $goodoutput); # Output the RPM list.
    if ($mode eq 'interactive')
      {
	print($out <<END);
Do you want to download the RPMs listed above (y/n)?
END
        my $in=<>;
	if ($in=~/^y/)
	  {
            print($out 'Please be patient... downloading into '.
		  '/tmp/loncapa_rpm_updates'."\n");
            print($out `perl $command_name --download`);
            clean_exit($mode,$out,0);
	  }
      }
    print($out <<END); # Output instructions to user about taking action.

Please visit ftp://$FTPUPDATES
and download the RPMS you need.
For instructions on working with (and upgrading) RPMS, please
visit http://www.rpm.org/max-rpm/.
To automatically download these RPMs to /tmp/loncapa_rpm_updates/,
run the CHECKRPMS command as "./CHECKRPMS --download"
END
    if ($mode eq 'cronmail')
      {
	print($out <<END); # Output more instructions to user.
CHECKRPMS should be located in /usr/local/loncapa/bin/.
END
      }
  }

clean_exit($mode,$out,0);

# ================================================================ Subroutines.

sub clean_exit
  {
    my ($mode,$out,$code)=@_;

    if ($mode eq 'cronmail') # If cronmail mode, then mail LON-CAPA sys admin.
      {
        close(FOUT);

	# Read in configuration to get e-mail addresses.
	my $perlvarref = read_conf('loncapa.conf');
	my %perlvar = %{$perlvarref};
	undef $perlvarref;
	delete $perlvar{'lonReceipt'}; # remove since sensitive
	delete $perlvar{'lonSqlAccess'}; # remove since sensitive

	# Set metadata for the e-mail.
        my $emailto = "$perlvar{'lonAdmEMail'}";

	my $subj=$perlvar{'lonHostID'}.', RPMS to upgrade';

	# Make the e-mail's subject header to describe whether up-to-date.
	if ($reallygoodoutput)
	  {
	    $subj = 'happy_lon: '.$subj; # Machine is up-to-date.
	  }
	else
	  {
	    $subj = 'ALERT_lon: '.$subj; # There are out-of-date RPMs.
	  }

	# Send the e-mail.
	my $date = `date +"\%e"`; # Always send a day after the "Ides" or after
	                          # the beginning of a month.  (In other words,
	                          # send an e-mail every two weeks regardless.)
        if (!$reallygoodoutput or
	    $date == 2 or
	    $date == 16)
	  {
	    system(
		   'metasend -b -t '.$emailto.' -s '.
		   "'$subj' -f /tmp/CHECKRPMS.$$ -m text/plain");
	  }
      }

    print($out <<END) if $mode eq 'html'; # If html mode, print ending tags.
</pre>
</body>
</html>
END
    exit($code);
  }

sub terminate
  {
    my ($mode,$out,$output);
    if ($mode eq 'html')
      {
        print($out <<END);
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"></meta>
<title>CHECKRPMS ERROR</title>
</head>
<body bgcolor="white">
<h1>CHECKRPMS ERROR</h1>
<hr />
<p><font color="red"><font size="+1">
END
      }
    print($out $output);
    if ($mode eq 'html')
      {
        print($out <<END);
</font></font></p></body></html>
END
      }
  }


# - read_conf: read LON-CAPA server configuration, especially PerlSetVar values
sub read_conf
  {
    my (@conf_files)=@_;
    my %perlvar;
    my $confdir='/etc/httpd/conf/';
    foreach my $filename (@conf_files,'loncapa_apache.conf')
      {
	open(CONFIG,'<'.$confdir.$filename) or
	    die("Can't read $confdir$filename");
	while (my $configline=<CONFIG>)
	  {
	    if ($configline =~ /^[^\#]*PerlSetVar/)
	      {
		my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
		chomp($varvalue);
		$perlvar{$varname}=$varvalue;
	      }
	  }
	close(CONFIG);
      }
    my $perlvarref=\%perlvar;
    return ($perlvarref);
  }