The beginnings of automating the rest of testbed update via perl

fragment scripts, much like we do with the DB updates. The intent
is to simplify testbed update for remote sites.

install/GNUmakefile.in

 #
 # EMULAB-COPYRIGHT
-# Copyright (c) 2000-2009 University of Utah and the Flux Group.
+# Copyright (c) 2000-2010 University of Utah and the Flux Group.
 # All rights reserved.
 #
 
@@ -12,7 +12,8 @@ SUBDIR		= install
 include $(OBJDIR)/Makeconf
 
 ifeq ($(STANDALONE_CLEARINGHOUSE),0)
-TARGETS	= boss-install ops-install fs-install dump-descriptors load-descriptors
+TARGETS	= libinstall.pm boss-install ops-install fs-install dump-descriptors \
+	load-descriptors update-install update-testbed
 else
 TARGETS = clrhouse-install
 endif
@@ -25,7 +26,10 @@ all: $(TARGETS)
 
 include $(TESTBED_SRCDIR)/GNUmakerules
 
-install: $(INSTALL_LIBDIR)/libinstall.pm
+install: $(INSTALL_LIBDIR)/libinstall.pm \
+	$(INSTALL_SBINDIR)/update-install \
+	$(INSTALL_SBINDIR)/update-testbed
 
 clean: 
-	rm -f boss-install ops-install fs-install
+	rm -f boss-install ops-install fs-install update-install
+	rm -f update-testbed

install/boss-install.in

@@ -66,7 +66,6 @@ my $PWD        = "/bin/pwd";
 my $PW         = "/usr/sbin/pw";
 my $PATCH      = "/usr/bin/patch";
 my $SSH_KEYGEN = "/usr/bin/ssh-keygen";
-my $PKG_INFO   = "/usr/sbin/pkg_info";
 my $PKG_ADD    = "/usr/sbin/pkg_add";
 my $PKG_DEL    = "/usr/sbin/pkg_delete";
 my $TOUCH      = "/usr/bin/touch";
@@ -87,8 +86,6 @@ my $MYSQLDUMP  = "/usr/local/bin/mysqldump";
 my $MYSQLINSTALL = "/usr/local/bin/mysql_install_db";
 my $MYSQLDBDIR = "/var/db/mysql";
 
-my $GMAKE      = "/usr/local/bin/gmake";
-
 #
 # Some files we edit/create
 #
@@ -170,17 +167,13 @@ my $NAMED_PIDFILE = "/var/run/named.pid";
 #
 # Some directories we care about
 #
-my $LOGDIR        = "$PREFIX/log";
 my $MYSQL_LOGDIR  = "$LOGDIR/mysql";
-my $RCDIR         = "/usr/local/etc/rc.d";
 my $USERSVAR_DIR  = "$PREFIX/usersvar";
 my $OPSDIR_DIR    = "$PREFIX/opsdir";
-my $PORTSDIR      = "/usr/ports";
 my $PORTSMISCDIR  = "$PORTSDIR/misc";
 my $MIBPATH       = "/usr/local/share/snmp/mibs";
 my $TFTP_DIR      = "$PREFIX/tftpboot";
 my $TFTP_PROJ_DIR = "$TFTP_DIR/proj";
-my $VARRUN        = "/var/run";
 my $ETCSSH	  = "/etc/ssh";
 
 #

install/fs-install.in

@@ -142,12 +142,10 @@ my $PW         = "/usr/sbin/pw";
 my $PATCH      = "/usr/bin/patch";
 my $NEWALIASES = "/usr/bin/newaliases";
 my $SH         = "/bin/sh";
-my $PKG_INFO   = "/usr/sbin/pkg_info";
 my $PKG_ADD    = "/usr/sbin/pkg_add";
 my $PWD        = "/bin/pwd";
 my $CP         = "/bin/cp";
 my $MV         = "/bin/mv";
-my $GMAKE      = "/usr/local/bin/gmake";
 my $ENV        = "/usr/bin/env";
 my $QUOTAON    = "/usr/sbin/quotaon";
 
@@ -175,11 +173,8 @@ my $SMBCONF_HEAD    = "$SMBCONF_FILE.head";
 #
 my $LIST_DIR      = "/etc/mail/lists";
 my $TIPLOG_DIR    = "/var/log/tiplogs";
-my $PORTSDIR      = "/usr/ports";
 my $PORTSMISCDIR  = "$PORTSDIR/misc";
 my $SRCDIR        = '@srcdir@';
-my $RCDIR         = "/usr/local/etc/rc.d";
-my $VARRUN        = "/var/run";
 
 #
 # And some lists that we use

install/libinstall.pm.in

@@ -4,12 +4,31 @@
 # Copyright (c) 2003-2010 University of Utah and the Flux Group.
 # All rights reserved.
 #
-
 #
-# A simple library for use in the installation scripts, to make them seem a
-# little more legitimate, instead of the quick hacks they are.
+# A simple library for use in the installation scripts, to make them
+# seem a little more legitimate, instead of the quick hacks they are.
 #
 use POSIX qw(strftime);
+use Exporter;
+use vars qw(@EXPORT $TOP_OBJDIR
+	    $TBROOT $LOGDIR $MAINSITE $PGENISUPPORT $GMAKE $PKG_INFO
+	    $PORTSDIR $VARRUN $RCDIR);
+
+@EXPORT = qw($TOP_OBJDIR
+	     $TBROOT $LOGDIR $MAINSITE $PGENISUPPORT $GMAKE $PKG_INFO
+	     $PORTSDIR $VARRUN $RCDIR);
+
+# Configure variables
+
+$TBROOT        = "@prefix@";
+$LOGDIR        = "$TBROOT/log";
+$MAINSITE      = @TBMAINSITE@;
+$PGENISUPPORT  = @PROTOGENI_SUPPORT@;
+$GMAKE         = "/usr/local/bin/gmake";
+$PKG_INFO      = "/usr/sbin/pkg_info";
+$PORTSDIR      = "/usr/ports";
+$VARRUN        = "/var/run";
+$RCDIR         = "/usr/local/etc/rc.d";
 
 #
 # Make sure that output gets printed right away
@@ -32,11 +51,24 @@ my $updatemode = 0;
 # Used by update-install to bump the version number.
 sub SET_TESTBED_VERSION($)  { $updatemode = $MAGIC_TESTBED_VERSION = $_[0]; }
 
+# Set by update-install.
+my $impotent   = 0;
+my $logfp;
+sub SET_IMPOTENT_MODE($)	    { $impotent = 1; $logfp = $_[0]; };
+
 #
 # Some programs we may call
 #
 my $FETCH = "/usr/bin/fetch";
 
+#
+# Figure out which directory we live in, so that some stages can do thing
+# relative to it.
+#
+$TOP_OBJDIR = `/usr/bin/dirname $0`;
+chomp $TOP_OBJDIR;
+$TOP_OBJDIR = "$TOP_OBJDIR/..";
+
 #
 # Let's pretend perl's exception mechanism has a sane name for the function
 # that raises an exception
@@ -44,7 +76,7 @@ my $FETCH = "/usr/bin/fetch";
 sub throw(@) {
     die @_,"\n";
 }
- 
+
 #
 # Start a new installation phase
 #
@@ -80,12 +112,15 @@ sub Phase($$$) {
 	print "\n";
     }
     printf "%-50s", $descrstring;
+    printf $logfp "%-50s", $descrstring
+	if ($impotent);
 
     #
     # Clear these, as we don't want to see the outputs of previous phases
     #
     @libinstall::lastExecOutput = ();
     $libinstall::lastCommand = undef;
+    @libinstall::loglines = ();
 
     #
     # Cool! TWO levels of Perl Hell just for me!
@@ -110,6 +145,8 @@ sub Phase($$$) {
     SWITCH: for ($@) {
 	(/^skip$/) && do {
 	    print "[ Skipped ($libinstall::reason) ]\n";
+	    print $logfp "[ Skipped ($libinstall::reason) ]\n"
+		if ($impotent && defined($logfp));
 	    $$parentSkipped++;
 	    $libinstall::phaseResults{$name} = $_;
 	    last SWITCH;
@@ -138,10 +175,24 @@ sub Phase($$$) {
 	    
 	    if ($hasSubPhase && $skipped && ($nonSkipped == 0)) {
 		print "[ Skipped   ] ($stamp)\n";
+		print $logfp "[ Skipped   ]\n"
+		    if ($impotent && defined($logfp));
 		$libinstall::phaseResults{$name} = "skip";
 		$$parentSkipped++;
 	    } else {
-		print "[ Succeeded ] ($stamp)\n";
+		if ($impotent) {
+		    if (defined($logfp)) {
+			print $logfp "[ $libinstall::reason ]\n";
+		    
+			print $logfp 
+			    "> " . join("\n> ", @libinstall::loglines) . "\n"
+			    if (@libinstall::loglines);
+		    }
+		    print "[ $libinstall::reason ]\n";
+		}
+		else {
+		    print "[ Succeeded ] ($stamp)\n";
+		}
 		$$parentNonSkipped++;
 		$libinstall::phaseResults{$name} = "succeed";
 	    }
@@ -221,6 +272,38 @@ sub PhaseWasSkipped($) {
     	($libinstall::phaseResults{$phase} =~ /^skip$/));
 }
 
+#
+# For impotent mode.
+#
+sub PhaseWouldHave($) {
+    ($libinstall::reason) = (@_);
+    throw "succeed";
+}
+
+#
+# Also for impotent mode; detailed logging.
+#
+sub PhaseLog(@) {
+    (@libinstall::loglines) = (@_);
+}
+
+#
+# Also for impotent mode; log differences to a file.
+#
+sub DiffFiles($$) {
+    my ($src,$dst) = @_;
+
+    return
+	if (!$impotent);
+
+    if (! -e $dst) {
+	my $stuff = `cat $src`;
+	PhaseLog(split('\n', $stuff));
+    }
+    my $diff = `diff $src $dst`;
+    PhaseLog(split('\n', $diff));
+}
+    
 #
 # Check to see if the phase is already done, as evidenced by the existance of
 # a file
@@ -272,11 +355,41 @@ sub DoneIfIdentical($$) {
     if (!-e $filename1 || !-e $filename2) {
 	return;
     }
-    if (!ExecQuiet("cmp -s $filename1 $filename2")) {
+    system("cmp -s $filename1 $filename2");
+    if (! $?) {
 	PhaseSkip("Files $filename1 and $filename2 are identical");
     }
 }
 
+#
+# Done if package installed.
+#
+sub DoneIfPackageInstalled($) {
+    my ($pname) = @_;
+    my $foo = `$PKG_INFO -x $pname`;
+    if (! $?) {
+	PhaseSkip("already installed");
+    }
+}
+
+#
+# Backup a file or fail.
+#
+sub BackUpFileFatal($)
+{
+    my ($filename) = @_;
+    my $suffix     = time();
+    my $backup     = $filename . "-" . $suffix;
+
+    PhaseFail("$filename does not exist")
+	if (! -e $filename);
+    PhaseFail("$filename already exists")
+	if (-e $backup);
+
+    ExecQuietFatal("/bin/cp -p $filename $backup")
+	if (!$impotent);
+}
+
 #
 # Check to see if filesystem already mounted
 #
@@ -317,6 +430,12 @@ sub DoneIfMounted($)
 #
 sub AppendToFile($@) {
     my ($filename, @lines) = @_;
+
+    if ($impotent) {
+	PhaseLog(@lines);
+	PhaseWouldHave("append to $filename");
+	return undef;
+    }
     if (!-e $filename) {
 	return "File $filename does not exist";
     }
@@ -349,6 +468,12 @@ sub AppendToFileFatal($@) {
 #
 sub CreateFile($;@) {
     my ($filename,@lines) = @_;
+
+    if ($impotent) {
+	PhaseLog(@lines);
+	PhaseWouldHave("create $filename");
+	return undef;
+    }
     if (-e $filename) {
 	return "File $filename already exists";
     }
@@ -385,6 +510,12 @@ sub ExecQuiet(@) {
     # Use a pipe read, so that we save away the output
     #
     my $commandstr = join(" ",@_);
+
+    if ($impotent) {
+	PhaseWouldHave("exec($commandstr)");
+        return 0;
+    }
+    
     my @output = ();
     open(PIPE,"$commandstr 2>&1 |") or return -1;
     while (<PIPE>) {
@@ -415,14 +546,14 @@ sub ExecQuietFatal(@) {
 }
 
 #
-# HUP a daemon, if it's PID file exists. If we can't kill it, we assume that
+# Signal a daemon, if it's PID file exists. If we can't kill it, we assume that
 # it's because it wasn't running, and skip the phase. Fails if it has trouble
 # reading the pid file.
 # Takes the name of the daemon as an argument, and assumes
 # that the pid file is /var/run/$name.pid
 #
-sub HUPDaemon($) {
-    my ($name) = @_;
+sub SignalDaemon($$) {
+    my ($name,$sig) = @_;
     my $pidfile = "/var/run/$name.pid";
     PhaseSkip("$name is not running") unless (-e $pidfile);
     open(PID,$pidfile) or PhaseFail("Unable to open pidfile $pidfile");
@@ -431,17 +562,34 @@ sub HUPDaemon($) {
     close PID;
 
     PhaseFail("Bad pid ($pid) in $pidfile\n") unless ($pid =~ /^\d+$/);
-    if (!kill 1, $pid) {
-	PhaseSkip("$name does not seem to be running");
+
+    if ($impotent) {
+	PhaseWouldHave("signal($sig) $name");
+	return;
+    }
+    if (!kill($sig, $pid)) {
+	PhaseSkip("$name is not running");
     }
 }
 
+sub HUPDaemon($) {
+    my ($name) = @_;
+
+    SignalDaemon($name, 'HUP');
+}
+
 #
 # Fetch a file from the network, using any protocol supported by fetch(1).
 # Arguments are URL and a local filename. Retunrns 1 if succesful, 0 if not.
 #
 sub FetchFile($$) {
     my ($URL, $localname) = @_;
+
+    if ($impotent) {
+	PhaseLog("$URL --> $filename");
+	PhaseWouldHave("fetch $URL");
+	return 1;
+    }
     if (ExecQuiet("$FETCH -o $localname $URL")) {
 	return 0;
     } else {

install/ops-install.in

@@ -42,7 +42,6 @@ my $CVSSUPPORT  = @CVSSUPPORT@;
 my $BUGDBSUPPORT= @BUGDBSUPPORT@;
 my $WIKISUPPORT = @WIKISUPPORT@;
 my $QUOTA_FSLIST= '@FS_WITH_QUOTAS@';
-my $LOGDIR      = "$PREFIX/log";
 my $ETCDIR      = "$PREFIX/etc";
 my $LIBDIR      = "$PREFIX/lib";
 my $SCRATCHDIR =  '@FSDIR_SCRATCH@';
@@ -183,13 +182,11 @@ my $PW         = "/usr/sbin/pw";
 my $PATCH      = "/usr/bin/patch";
 my $NEWALIASES = "/usr/bin/newaliases";
 my $SH         = "/bin/sh";
-my $PKG_INFO   = "/usr/sbin/pkg_info";
 my $PKG_ADD    = "/usr/sbin/pkg_add";
 my $PKG_DEL    = "/usr/sbin/pkg_delete";
 my $PWD        = "/bin/pwd";
 my $CP         = "/bin/cp";
 my $MV         = "/bin/mv";
-my $GMAKE      = "/usr/local/bin/gmake";
 my $ENV        = "/usr/bin/env";
 my $MOUNT      = "/sbin/mount";
 my $TAR	       = "/usr/bin/tar";
@@ -234,12 +231,9 @@ my $MYSQL_LOGDIR    = "$LOGDIR/mysql";
 #
 my $LIST_DIR      = "/etc/mail/lists";
 my $TIPLOG_DIR    = "/var/log/tiplogs";
-my $PORTSDIR      = "/usr/ports";
 my $PORTSMISCDIR  = "$PORTSDIR/misc";
 my $SRCDIR        = '@srcdir@';
 my $TOP_SRCDIR    = "@top_srcdir@";
-my $RCDIR         = "/usr/local/etc/rc.d";
-my $VARRUN        = "/var/run";
 
 #
 # And some lists that we use
@@ -840,16 +834,16 @@ Phase "syslog", "Setting up syslog", sub {
 	    # Find the cron line, after which we place our auth.info line
 	    #
 	    if ($line =~ /^cron/) {
-		print SC "# " . MAGIC_TESTBED_START . "\n";
+		print SC "# " . MAGIC_TESTBED_START() . "\n";
 		print SC "auth.info\t\t\t\t\t/var/log/logins\n";
-		print SC "# " . MAGIC_TESTBED_END . "\n";
+		print SC "# " . MAGIC_TESTBED_END() . "\n";
 	    }
 	}
 
 	#
 	# Put a few more lines at the end
 	#
-	print SC "# " . MAGIC_TESTBED_START . "\n";
+	print SC "# " . MAGIC_TESTBED_START() . "\n";
 	print SC "!capture\n";
 	print SC "*.*\t\t\t\t\t\t/var/log/tiplogs/capture.log\n";
 	print SC "!mountd\n";
@@ -858,7 +852,7 @@ Phase "syslog", "Setting up syslog", sub {
 	print SC "*.*\t\t\t\t\t\t${LOGDIR}/pubsubd.log\n";
 	print SC "!elvin_gateway\n";
 	print SC "*.*\t\t\t\t\t\t${LOGDIR}/elvin_gateway.log\n";
-	print SC "# " . MAGIC_TESTBED_END . "\n";
+	print SC "# " . MAGIC_TESTBED_END() . "\n";
 	close SC;
     };
 

install/update-install.in

+#!/usr/bin/perl -w
+#
+# EMULAB-COPYRIGHT
+# Copyright (c) 2010 University of Utah and the Flux Group.
+# All rights reserved.
+#
+use strict;
+use English;
+use Getopt::Std;
+
+#
+# Update DB.
+#
+sub usage()
+{
+    print STDERR "Usage: update-install [-v] [-s] [-f] [<version>]\n";
+    exit(-1);
+}
+my $optlist = "dsfvp:qa:ci";
+my $debug   = 0;
+my $force   = 0;
+my $single  = 0;
+my $verify  = 0;
+my $quiet   = 0;
+my $check   = 0;
+my $impotent= 0;
+my $path    = ".";
+my $phase;
+my $version;
+my $verify_count = 0;
+my $logfp;
+
+#
+# Configure variables
+#
+my $TB	      = "@prefix@";
+my $TBOPS     = "@TBOPSEMAIL@";
+my $logfile   = "/var/tmp/install.$$";
+
+# Protos
+sub Fatal($);
+
+# un-taint path
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin:/usr/site/bin';
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+#
+# Turn off line buffering on output
+#
+$| = 1;
+
+#
+# Do not modify the include path if it was specified when invoked.
+# This allows update to run from the build tree.
+#
+BEGIN
+{
+    eval "require emdbi";
+    if ($@) {
+	unshift(@INC, "@prefix@/lib");
+    }
+}
+use emdb;
+use libtestbed;
+use libinstall;
+
+# Need this below.
+my $objdir = `/bin/pwd`;
+chomp($objdir);
+
+#
+# Parse command arguments.
+#
+my %options = ();
+if (! getopts($optlist, \%options)) {
+    usage();
+}
+if (defined($options{"a"})) {
+    $phase = $options{"a"};
+    Fatal("Phase (-a) must be either 'pre' or 'post'")
+	if (! ($phase eq "pre" || $phase eq "post"));
+}
+if (defined($options{"d"})) {
+    $debug = 1;
+}
+if (defined($options{"c"})) {
+    $check = 1;
+}
+if (defined($options{"i"})) {
+    $impotent = 1;
+}
+if (defined($options{"f"})) {
+    $force = 1;
+}
+if (defined($options{"v"})) {
+    $verify = 1;
+}
+if (defined($options{"q"})) {
+    $quiet = 1;
+}
+if (defined($options{"p"})) {
+    $path = $options{"p"};
+}
+if (defined($options{"s"})) {
+    $single = 1;
+    if (@ARGV != 1) {
+	Fatal("Must provide a version argument when using -s option");
+    }
+}
+if (@ARGV > 1) {
+    usage();
+}
+$version = shift()
+    if (@ARGV);
+
+#
+# Must be root if actually doing this.
+#
+if ($UID && !($impotent || $check || $verify)) {
+    Fatal("This script must be run as root! Maybe use sudo?")
+}
+
+if ($impotent) {
+    open(LOGFP, "> $logfile")
+	or Fatal("Could not open $logfile");
+    $logfp = *LOGFP;
+
+    SET_IMPOTENT_MODE($logfp);
+}
+
+#
+# If no version number provided, then grab it from the DB.
+#
+if (!defined($version)) {
+    my $query_result =
+	DBQueryFatal("select value from version_info ".
+		     "where name='install'");
+    if (!$query_result || !$query_result->numrows) {
+	$version = "5.0";
+
+	DBQueryFatal("insert into version_info ".
+		     "values ('install', '$version')");
+    }
+    else {
+	($version) = $query_result->fetchrow_array();
+    }
+}
+if (! ($version =~ /^[\d\.]+$/)) {
+    Fatal("'$version' does not look like a reasonable starting version.");
+}
+
+#
+# Split apart the version number. Assumed to be in dotted notation.
+#
+my @dots  = split(/\./, "$version");
+my $start = pop(@dots);
+
+#
+# If no dots, then assume the current directory. 
+#
+if (@dots) {
+    my $dir = join("/", @dots);
+    $path = "$path/$dir";
+}
+unshift(@INC, "$path");
+
+my @files;
+
+if ($single) {
+    Fatal("Update file $start does not exist")
+	if (! -e "$path/$start");
+    # Just the one file.
+    @files = ($start);
+}
+else {
+    #
+    # Open up the current directory. We want all numbered files.
+    #
+    opendir(DIR, $path) or
+	Fatal("Could not opendir the current directory");
+    @files  = grep { /^\d*$/ } readdir(DIR);
+    closedir(DIR);
+}
+
+#
+# Sort them since we we want to start at the right file, and proceed
+# in order.
+#
+@files = sort {$a <=> $b} @files;
+
+#
+# Now process each file starting at the start version.
+#
+sub RunUpdates($)
+{
+    my ($phase) = @_;
+    
+    foreach my $file (@files) {
+	next
+	    if (!$force && !$single && $file <= $start);
+	next
+	    if ($single && $file != $start);
+
+	my $fullpath = join("/", @dots) . "/$file";
+	my $revision = join(".", @dots);
+	$revision .= (@dots ? "." : "") . $file;
+
+	if ($verify) {
+	    print "Need install update $fullpath\n";
+	    $verify_count++;
+	    next;
+	}
+
+	if ($check) {
+	    print "Syntax checking update $fullpath\n";
+	}
+	elsif ($impotent) {
+	    print "*** Processing (impotent mode) update $fullpath\n";
+	}
+	else {
+	    print "*** Processing update $fullpath\n";
+	}
+
+	# Undefine this to make sure we get a new version each file.
+	undef &InstallUpdate;
+
+	# This just loads the file.
+	my $return = do $file;
+	if (!defined($return)) {
+	    Fatal("  could not parse $fullpath: $@") if $@;
+	    Fatal("  could not do $fullpath: $!")    if $!;
+	}
+	next
+	    if ($check);
+	
+	SET_TESTBED_VERSION($revision);
+    
+	# Then we run it.
+	if (InstallUpdate($revision, $phase, $impotent) != 0) {
+	    Fatal("  returned non-zero; aborting.\n");
+	}
+	# Mark that we have done it. 
+	DBQueryFatal("update version_info set value='$revision' ".
+		     "where name='install'")
+	    if (!$single && !$force && !$impotent && $phase eq "post");
+    }
+}
+
+if ($verify) {
+    RunUpdates("pre");
+    
+    exit($verify_count)
+	if (!$verify_count || $quiet);
+
+    print "*** You have install update scripts that have not been run.\n";
+    print "    As a safety measure, you will not be able to install until\n";