install-tarfile

#!/usr/bin/perl -wT

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#

use English;
use Getopt::Std;
use POSIX 'setsid';

# Drag in path stuff so we can find emulab stuff.
# XXX Temporary until I have the new tmcc library finished!
BEGIN { require "/etc/emulab/paths.pm"; import emulabpaths; }

#
# Install a tarfile. This script is run from the setup code on client nodes.
# By default the tarfile is accessed directly via NFS, if '-c' is specified
# the tar file 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 tar filename must start with /proj, except if
# running with jail option. Must be run as root.
#
sub usage()
{
    print STDOUT "Usage: install-tarfile [-d] [-ct] [-n nodeid] <installdir> ".
	"<filename>\n";
    exit(-1);
}
my $optlist  = "cdtn:";

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

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

#
# No configure vars.
#
my $IDENTFILE      = "/var/db/testbed.tarfiles";
my $tarfile        = "";
my $decompressflag = "";
my $installdir     = "/";
my $usewget	   = 0;
my $copymode	   = 0;
my $debug	   = 0;
my $copyfile;
my $nodeid;
my $keyhash;

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

# Protos
sub GetTarFile($$$);

#
# Must be running as root to work. 
#
if ($EUID != 0) {
    die("Must be run as root! Try using sudo or su1!\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"})) {
    $copymode = 1;
    $usewget  = 1;
}
if (defined($options{"n"})) {
    $nodeid = $options{"n"};
    if ($nodeid =~ /^([-\w]+)$/) {
	$nodeid = $1;
    }
    else {
	fatal("Tainted nodeid: $nodeid");
    }
}
# XXX compat
if (defined($options{"j"})) {
    $copymode = 1;
    $usewget  = 1;
}
if (@ARGV != 2) {
    usage();
}
$installdir = $ARGV[0];
$tarfile    = $ARGV[1];

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

#
# Make sure the installdir exists!
#
if (! -d $installdir) {
    fatal("$installdir does not exist or is not accessible!");
}

#
# Check to make sure this tarfile has not already been installed. Update
# the file now. If the tar fails, we got big problems.
#
if (-e $IDENTFILE) {
    if (! system("egrep -q -s '^${tarfile}' $IDENTFILE")) {
	print STDOUT "Tarfile $tarfile has already been installed!\n";
	exit(1);
    }
}

#
# Must be able to see the tarfile 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 $tarfile) {
	fatal("$tarfile does not exist or is not accessible!");
    }
}
else {
    $copyfile = `mktemp /var/tmp/tarball.XXXXXX`;

    if ($copyfile =~ /^([-\@\w\.\/]+)$/) {
	$copyfile = $1;
    }
    else {
	die("Bad data in copyfile name: $copyfile");
    }
    GetTarFile($tarfile, $copyfile, $usewget);
    #
    # Dies on any failure!
    #
}

#
# Add to index first; if fails too bad.
# 
if (system("echo \"$tarfile\" >> $IDENTFILE")) {
    fatal("Could not update $IDENTFILE");
}

#
# Figure what decompression flag is required, based on file extension.
#
SWITCH: for ($tarfile) {
    /^.*\.tar\.Z$/   && do {$decompressflag = "-Z"; last SWITCH; } ;
    /^.*\.tar\.gz$/  && do {$decompressflag = "-z"; last SWITCH; } ;
    /^.*\.tar\.tgz$/ && do {$decompressflag = "-y"; last SWITCH; } ;
    /^.*\.tar$/      && do {last SWITCH; } ;
}

#
# Install tar file from root?
# 
if (! chdir($installdir)) {
    fatal("Could not chdir to $installdir: $!\n");
}

#
# Run the tarfile. 
#
if ($copymode) {
    $tarfile = $copyfile;
}
system("tar $decompressflag -xf $tarfile");
$exit_status = $? >> 8;
if ($copymode) {
    unlink($copyfile);
}

exit($exit_status);

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

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

#
# Get a tarfile from the server via tmcc and stash.
#
sub GetTarFile($$$)
{
    my ($tarfile, $copyfile, $usewget) = @_;
    my $buf;
    my $bytelen;

    #
    # If copying via NFS, must watch for read errors and retry.
    #
    if (! $usewget) {
	open(TMCC, "< $tarfile")
	    or fatal("Could not open tarfile on server!");
	$bytelen = (stat($tarfile))[7];

	#
	# Open the target file and start dumping the data in.
	#
	open(JFILE, "> $copyfile")
	    or fatal("Could not open local file $copyfile: $!");

	#
	# Deal with NFS read failures
	#
	my $foffset = 0;
	my $retries = 5;

	while ($bytelen) {
	    my $rlen = sysread(TMCC, $buf, 8192);

	    if (! defined($rlen)) {
		#
		# If we are copying the file via NFS, retry a few times
		# on error to avoid the changing-exports-file server problem.
		if ($retries > 0 && sysseek(TMCC, $foffset, 0)) {
		    warn("*** WARNING retrying read of $tarfile ".
			 "at offset $foffset\n");
		    $retries--;
		    sleep(2);
		    next;
		}
		fatal("Error reading tarball $tarfile: $!");
	    }
	    if ($rlen == 0) {
		last;
	    }
	    if (! syswrite(JFILE, $buf)) {
		fatal("Error writing tarfile $copyfile: $!");
	    }
	    $foffset += $rlen;
	    $bytelen -= $rlen;
	    $retries = 5;
	}
	close(JFILE);
	close(TMCC);
    }
    else {
	#
	# 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 our boss node.
	# 
	my ($www) = split(" ", `tmcc bossinfo`);
	die("Could not get bossinfo!")
	    if ($?);

	if ($www =~ /^[-\w]+\.(.*)$/) {
	    $www = "www.${1}";
	}
	else {
	    fatal("Tainted bossinfo $www!");
	}

	#
	# Okay, run wget with the proper arguments. 
	#
	my $cmd = "wget -q -O $copyfile ".
	          ($debug ? "--server-response " : "") .
	          "'https://${www}/spewrpmtar.php3".
	          "?nodeid=${nodeid}&file=${tarfile}&key=${keyhash}'";
    
	if ($debug) {
	    print STDERR "$cmd\n";
	}
	system($cmd);

	fatal("Could not retrieve $tarfile from $www")
	    if ($?);
    }
    return 0;
}