#!/usr/bin/perl -w
#
# Copyright (c) 2000-2012 University of Utah and the Flux Group.
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file 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 Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
use English;
use Getopt::Std;
use POSIX qw(mktime);

# Drag in path stuff so we can find emulab stuff.
BEGIN { require "/etc/emulab/paths.pm"; import emulabpaths; }

#
# Install an RPM. This script is run from the setup code on client nodes.
# By default the RPM is accessed directly via NFS, if '-c' is specified
# the RPM is copied over first either via NFS (the default) or tmcc
# (-t option).
#
# Exit Value Matters!: 0 if installed okay
#                      1 if already installed
#                     -1 if something goes wrong.
#
# To ensure safety, the RPM filename must start with /proj, except if
# running with jail option. Must be run as root.
#
sub usage()
{
    print STDOUT "Usage: install-rpm [-d] [-ct] [-n nodeid] [-S server] <filename>\n";
    exit(-1);
}
my $optlist  = "dctn:S:";

#
# Turn off line buffering on output
#
$| = 1;

#
# Untaint env.
# 
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# No configure vars.
#
my $IDENTFILE      = "$DBDIR/testbed.rpms";
my $rpm            = "";
my $usewget	   = 0;
my $wgetserver	   = "";
my $copymode	   = 0;
my $debug	   = 0;
my $copyfile;
my $nodeid;
my $keyhash;
my $filemd5;
my @identlines     = ();
my $installed      = 0;

#
# Load the OS independent support library. It will load the OS dependent
# library and initialize itself. 
#
use libsetup;
use libtmcc;

# Protos
sub GetRPMFile($$$$$$$$);
sub GetMD5($);
sub WriteIdentFile();

#
# Must be running as root to work. 
#
if ($EUID != 0) {
    die("Must be run as root! Try using sudo!\n");
}

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"c"})) {
    $copymode = 1;
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"t"})) {
    $usewget = 1;
    $copymode = 1;
}
if (defined($options{"S"})) {
    $wgetserver = $options{"S"};
    if ($wgetserver =~ /^([-\w\.]+)$/) {
	$wgetserver = $1;
    }
}
if (defined($options{"n"})) {
    $nodeid = $options{"n"};
    if ($nodeid =~ /^([-\w]+)$/) {
	$nodeid = $1;
    }
}
if (@ARGV != 1) {
    usage();
}
$rpm    = $ARGV[0];

#
# Untaint the arguments.
#
# Note different taint check (allow /).
if ($rpm =~ /^([-\w.\/\+]+)$/) {
    $rpm = $1;
}
else {
    fatal("Tainted filename: $rpm");
}

#
# Check to make sure this rpm has not already been installed.
# If so, we get the old timestamp and md5 so we can compare against
# current ones.
# We need to update the stamp/md5 in place in case it has changed, so
# copy out all the identlines so we can write them back later. We do not
# copyout the current one of course; we make up a new line at the end
# of this script based on the new info.
# 
if (-e $IDENTFILE) {
    if (!open(IDENT, $IDENTFILE)) {
	fatal("Could not open $IDENTFILE: $!");
    }
    while (<IDENT>) {
	if ($_ =~ /^([-\w\.\/\+]*) ([\d]*) ([\w]*)$/) {
	    my $file = $1;
	    my $stamp= $2;
	    my $md5  = $3;

	    if ($file eq $rpm) {
		#
		# Save the info and continue;
		#
		$oldstamp = $stamp;
		$oldmd5   = $md5;
		next;
	    }
	    push(@identlines, "$file $stamp $md5");
	}
	else {
	    warn("*** WARNING: Bad line in $IDENTFILE: $_\n");
	}
    }
    close(IDENT);
}

#
# Must be able to see the RPM if not copying. The front end
# ensures that its in a reasonable place, but have to make sure here.
#
if (! $copymode) {
    #
    # Make sure its really there.
    #
    if (! -r $rpm) {
	fatal("$rpm does not exist or is not accessible!");
    }

    #
    # Compare timestamp. If no change, we are done. 
    #
    (undef,undef,undef,undef,undef,undef,
     undef,undef,undef,$filestamp) = stat($rpm);

    if (defined($oldstamp) && $oldstamp >= $filestamp) {
	print STDOUT "RPM $rpm has already been installed!\n";
	exit(1);
    }

    #
    # Otherwise compare MD5.
    #
    $filemd5 = GetMD5($rpm);
    if (defined($oldmd5) && $filemd5 eq $oldmd5) {
	print STDOUT "RPM $rpm has already been installed!\n";
	# Must write a new ident file to avoid repeated checks.
	push(@identlines, "$rpm $filestamp $filemd5");
	WriteIdentFile();
	exit(1);
    }
}
else {
    $copyfile = `mktemp /var/tmp/rpm.XXXXXX`;

    if ($copyfile =~ /^([-\@\w\.\/]+)$/) {
	$copyfile = $1;
    }
    else {
	die("Bad data in copyfile name: $copyfile");
    }
    #
    # Dies on any failure.
    # Returns >0 if server copy has not been modifed.
    # Returns =0 if okay to install, and gives us new stamp/md5.
    #
    if (GetRPMFile($rpm, $copyfile, $usewget, $wgetserver,
		   $oldstamp, $oldmd5, \$filestamp, \$filemd5)) {
	print STDOUT "RPM $rpm has already been installed!\n";
	if (defined($filestamp) && $filestamp != $oldstamp) {
	    # Must write a new ident file to avoid repeated checks.
	    push(@identlines, "$rpm $filestamp $oldmd5");
	    WriteIdentFile();
	}
	unlink($copyfile)
	    if (-e $copyfile);
	exit(1);
    }
}

#
# Okay, add new info to the list for update.
#
push(@identlines, "$rpm $filestamp $filemd5");

#
# Run the RPM. 
#
if ($copymode) {
    $rpm = $copyfile;
}
my $oumask = umask(0);
system("rpm -U --force --nodeps $rpm");
$exit_status = $? >> 8;
umask($oumask);
if ($copymode) {
    unlink($copyfile);
}

#
# Recreate the index file if the install was okay.
#
if (!$exit_status) {
    WriteIdentFile();
}
exit($exit_status);

sub fatal {
    local($msg) = $_[0];

    if ($copymode && defined($copyfile) && -e $copyfile) {
	unlink($copyfile);
    }
    die("*** $0:\n".
	"    $msg\n");
}

#
# Get an RPM from the server via tmcc and stash.
#
sub GetRPMFile($$$$$$$$)
{
    my ($rpm, $copyfile, $usewget, $wgetserver,
	$oldstamp, $oldmd5, $filestamp, $filemd5) = @_;
    my $buf;

    if (! $usewget) {
	print STDOUT "Copying RPM $rpm across NFS\n"
	    if ($debug);

	#
	# Compare timestamp. If no change, we are done. 
	#
	my (undef,undef,undef,undef,undef,undef,undef,undef,undef,$stamp) =
	    stat($rpm);

	if (defined($oldstamp) && $oldstamp >= $stamp) {
	    print STDOUT "Timestamp ($stamp) for $rpm unchanged!\n"
		if ($debug);
	    return 1;
	}

	#
	# Must do this for caller so that if the MD5 has not changed,
	# the caller can update the timestamp in the ident file.
	#
	$$filestamp = $stamp;
	
	#
	# If copying via NFS, use special copy routine which retries on error.
	#
	if (!copyfilefromnfs($rpm, $copyfile, 1)) {
	    unlink($copyfile);
	    fatal("Could not copy RPM $rpm from server!");
	}

	#
	# Compare md5.
	#
	my $md5 = GetMD5($copyfile);
	if (defined($oldmd5) && $oldmd5 eq $md5) {
	    print STDOUT "MD5 ($md5) for $rpm unchanged!\n"
		if ($debug);
	    return 2;
	}
	$$filemd5   = $md5;
    }
    else {
	print STDOUT "Fetching RPM $rpm from $wgetserver via HTTP\n"
	    if ($debug);

	#
	# Need the nodeid and the keyhash. We allow the nodeid to be
	# overridden on the command line, but thats just a debugging
	# feature.
	#
	if (!defined($nodeid)) {
	    #
	    # Eventually, use tmcc which will cache the result. 
	    # 
	    open(FD, "< " . TMNODEID()) or
		fatal("Could not open ". TMNODEID() . ": $!");
	    $nodeid = <FD>;
	    close(FD);
	    fatal("Could not get our nodeid!")
		if (!defined($nodeid));

	    if ($nodeid =~ /^([-\w]+)$/) {
		$nodeid = $1;
	    }
	}
	#
	# Eventually, use tmcc which will cache the result. 
	# 
	open(FD, "< " . TMKEYHASH()) or
	    fatal("Could not open ". TMKEYHASH() . ": $!");
	$keyhash = <FD>;
	close(FD);
	fatal("Could not get our keyhash!")
		if (!defined($keyhash));
	if ($keyhash =~ /^([\w]+)$/) {
	    $keyhash = $1;
	}

	#
	# Lastly, need the server.
	# For compat, use boss (aka, www) if not specified.
	#
	if ($wgetserver eq "") {
	    ($wgetserver) = tmccbossname();
	    if ($wgetserver =~ /^[-\w]+\.(.*)$/) {
		$wgetserver = "www.${1}";
	    }
	    else {
		fatal("Tainted bossinfo $wgetserver!");
	    }
	}
	my $www  = "https://$wgetserver";
	if ($wgetserver =~ /^users/) {
	    $www .= "/spewrpmtar";
	} else {
	    $www .= "/spewrpmtar.php3";
	}

	#
	# Okay, run wget with the proper arguments. 
	#
	my $cmd = "wget -nv -O $copyfile ".
	          "--no-check-certificate ".
	          ($debug ? "--server-response " : "") .
	          "'${www}?nodeid=${nodeid}&file=${rpm}&key=${keyhash}" .
		  (defined($oldstamp) ? "&stamp=$oldstamp" : "") .
		  (defined($oldmd5)   ? "&md5=$oldmd5" : "") .
		  "'";
    
	if ($debug) {
	    print STDERR "$cmd\n";
	}

	#
	# We need to read back the response to see if the file was
	# unchanged. This is dumb; why doesn't wget exit with reasonable
	# error codes?
	#
	my $nochange = 0;
	if (!open(WGET, "$cmd 2>&1 |")) {
	    fatal("Cannot start wget: $!\n");
	}
	while (<WGET>) {
	    print $_
		if ($debug);

	    # Ick!
	    if ($_ =~ /^.* ERROR 304.*$/i) {
		$nochange = 1;
	    }
	}
	if (! close(WGET)) {
	    if ($?) {
		fatal("Could not retrieve $rpm from $wgetserver")
		    if (!$nochange);
		# Otherwise, not modifed. 
		print STDOUT "Timestamp for $rpm unchanged!\n"
		    if ($debug);
		return 1;
	    }
	    else {
		fatal("Error closing wget pipe: $!\n");
	    }
	}
	# Must do this for caller so that if the MD5 has not changed,
	# the caller can update the timestamp in the ident file.
	#
	# Always use GM time for this. The server expects it.
	$$filestamp = mktime(gmtime(time()));
	
	#
	# We got a file. Compare the MD5 now. 
	#
	my $md5 = GetMD5($copyfile);
	if (defined($oldmd5) && $oldmd5 eq $md5) {
	    print STDOUT "MD5 ($md5) for $rpm unchanged!\n"
		if ($debug);
	    return 2;
	}
	$$filemd5 = $md5;
    }
    return 0;
}

#
# Get MD5 of file.
#
sub GetMD5($)
{
    my ($file) = @_;
    my $md5;

    if ($OSNAME eq "linux" || $OSNAME eq "cygwin") {
	$md5 = `md5sum $file`;
    
	if ($md5 =~ /^([\w]*)\s*.*$/) {
	    $md5 = $1;
	}
	else {
	    fatal("Bad MD5 for $file: $md5.");
	}
    }
    elsif ($OSNAME eq "freebsd") {
	$md5 = `md5 -q $file`;
    
	if ($md5 =~ /^([\w]*)$/) {
	    $md5 = $1;
	}
	else {
	    fatal("Bad MD5 for $file: $md5.");
	}
    }
    else {
	fatal("Do not know how to compute MD5s!");
    }
    return $md5;
}

#
# Recreate the ident file.
#
sub WriteIdentFile()
{
    if (!open(IDENT, "> $IDENTFILE")) {
	fatal("Could not open $IDENTFILE for writing: $!");
    }
    foreach my $id (@identlines) {
	print IDENT "$id\n";
    }
    close(IDENT);
}
