Add support geni-lib scripts. Work in progress.

0002fc0f · Leigh B Stoller · c9b4d551 · 0002fc0f · 0002fc0f · 0002fc0f
Commit 0002fc0f authored Nov 11, 2014 by Leigh B Stoller
--- a/apt/APT_Profile.pm.in
+++ b/apt/APT_Profile.pm.in
@@ -46,7 +46,9 @@ use vars qw(@ISA @EXPORT $AUTOLOAD);
 use EmulabConstants;
 use emutil;
 use emdb;
+use APT_Dataset;
 use GeniXML;
+use GeniHRN;
 use libtestbed;
 use English;
 use Data::Dumper;
@@ -58,6 +60,14 @@ my $TBOPS         = "@TBOPSEMAIL@";

 my $debug = 0;

+# Concat id/vers.
+sub versid($)
+{
+    my ($self) = @_;
+
+    return $self->profileid() . ":" . $self->version();
+}
+
 sub BlessRow($$)
 {
    my ($class, $row) = @_;
@@ -314,6 +324,9 @@ sub Create($$$$$$)
 	$vquery .= ",parent_profileid=" . $parent->profileid();
 	$vquery .= ",parent_version=" . $parent->version();
    }
+    if (exists($argref->{'script'}) && $argref->{'script'} ne "") {
+	$vquery .= ",script=" . DBQuoteSpecial($argref->{'script'});
+    }

    # Back to the main table.
    $cquery .= ",uuid='$puuid'";
@@ -674,6 +687,53 @@ sub UpdateDiskImage($$)
    return 0;
 }

+#
+# Check blockstores. 
+#
+sub CheckDatasets($$$)
+{
+    my ($xml, $project, $pmsg) = @_;
+    my $rspec = GeniXML::Parse($xml);
+    if (! defined($rspec)) {
+	print STDERR "CheckDatasets: Could not parse rspec\n";
+	return -1;
+    }
+    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
+	foreach my $blockref (GeniXML::FindNodesNS("n:blockstore",
+						   $ref,
+				   $GeniXML::EMULAB_NS)->get_nodelist()) {
+	    my $leaseurn = GeniXML::GetText("persistent", $blockref);
+	    if (defined($leaseurn) && !GeniHRN::IsValid($leaseurn)) {
+		$$pmsg = "Persistent dataset name is not a valid URN";
+		return 1;
+	    }
+	    my ($authority, $type, $id) = GeniXML::Parse($leaseurn);
+	    #
+	    # Not all backends have blockstore support.
+	    #
+	    if (!APT_Dataset::ValidBlockstoreBackend($authority)) {
+		$$pmsg = "Persistent dataset is not on a valid aggregate";
+		return 1;
+	    }
+	    #
+	    # Dataset must already exists on the aggregate.
+	    #
+	    my $pid     = $project->pid();
+	    my $dataset = APT_Dataset->Lookup("$pid/$id");
+	    if (!defined($dataset)) {
+		$$pmsg = "Persistent dataset '$pid/$id' does not exist";
+		return 1;
+	    }
+	    my ($d_authority) = GeniXML::Parse($dataset->aggregate_urn());
+	    if ($d_authority ne $authority) {
+		$$pmsg = "Persistent dataset '$pid/$id' in not on $authority";
+		return 1;
+	    }
+	}
+    }
+    return 0;
+}
+
 sub IsHead($)
 {
    my ($self) = @_;

--- a/apt/manage_profile.in
+++ b/apt/manage_profile.in
@@ -35,19 +35,18 @@ use POSIX qw(setsid);
 #
 sub usage()
 {
-    print("Usage: manage_profile [-u uuid | -s uuid] <xmlfile>\n");
-    print("Usage: manage_profile [-r | -p] profile\n");
+    print("Usage: manage_profile create [-s uuid] <xmlfile>\n");
+    print("Usage: manage_profile update <profile> <xmlfile>\n");
+    print("Usage: manage_profile publish <profile>\n");
+    print("Usage: manage_profile delete <profile>\n");
    exit(-1);
 }
-my $optlist     = "du:rs:t:fp";
+my $optlist     = "ds:t:";
 my $debug       = 0;
-my $verify      = 0;	# Check data and return status only.
 my $update      = 0;
 my $snap        = 0;
-my $delete      = 0;
-my $skipadmin   = 0;
-my $force       = 0; # With delete.
 my $uuid;
+my $rspec;
 my $profile;
 my $instance;
 my $webtask;
@@ -92,6 +91,31 @@ sub UserError(;$);
 sub DeleteProfile($);
 sub PublishProfile($);

+# Parse args below.
+if (@ARGV < 2) {
+    usage();
+}
+my $action = shift(@ARGV);
+
+# The web interface (and in the future the xmlrpc interface) sets this.
+my $this_user = User->ImpliedUser();
+if (! defined($this_user)) {
+    $this_user = User->ThisUser();
+    if (!defined($this_user)) {
+	fatal("You ($UID) do not exist!");
+    }
+}
+
+if ($action eq "delete") {
+    exit(DeleteProfile($ARGV[0]));
+}
+elsif ($action eq "publish") {
+    exit(PublishProfile($ARGV[0]));
+}
+elsif (! ($action eq "create" || $action eq "update")) {
+    usage();
+}
+
 #
 # Parse command arguments. Once we return from getopts, all that should be
 # left are the required arguments.
@@ -103,16 +127,6 @@ if (! getopts($optlist, \%options)) {
 if (defined($options{"d"})) {
    $debug = 1;
 }
-if (defined($options{"f"})) {
-    $force = 1;
-}
-if (defined($options{"v"})) {
-    $verify = 1;
-}
-if (defined($options{"u"})) {
-    $update = 1;
-    $uuid = $options{"u"};
-}
 if (defined($options{"s"})) {
    $snap = 1;
    $uuid = $options{"s"};
@@ -120,27 +134,11 @@ if (defined($options{"s"})) {
 if (defined($options{"t"})) {
    $webtask_id = $options{"t"};
 }
-if (@ARGV != 1) {
-    usage();
-}
-# The web interface (and in the future the xmlrpc interface) sets this.
-my $this_user = User->ImpliedUser();
-if (! defined($this_user)) {
-    $this_user = User->ThisUser();
-    if (!defined($this_user)) {
-	fatal("You ($UID) do not exist!");
-    }
-}
-
-# Remove profile.
-if (defined($options{"r"})) {
-    exit(DeleteProfile($ARGV[0]));
-}
-elsif (defined($options{"p"})) {
-    exit(PublishProfile($ARGV[0]));
+if ($action eq "update") {
+    $update = 1;
+    $uuid = shift(@ARGV);
 }
-
-my $xmlfile  = shift(@ARGV);
+my $xmlfile = shift(@ARGV);

 #
 # These are the fields that we allow to come in from the XMLfile.
@@ -162,6 +160,7 @@ my %xmlfields =
     "profile_public"      => ["public",	$SLOT_OPTIONAL|$SLOT_UPDATE],
     "profile_shared"      => ["shared",	$SLOT_OPTIONAL|$SLOT_UPDATE],
     "rspec"		   => ["rspec",		$SLOT_REQUIRED|$SLOT_UPDATE],
+     "script"		   => ["script",	$SLOT_OPTIONAL|$SLOT_UPDATE],
 );

 #
@@ -232,7 +231,7 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
 	    $value = $default;
 	}
    }
-    if ($required & $SLOT_ADMINONLY && !$skipadmin) {
+    if ($required & $SLOT_ADMINONLY) {
 	# Admin implies optional, but thats probably not correct approach.
 	$errors{$key} = "Administrators only"
 	    if (! $this_user->IsAdmin());
@@ -247,6 +246,10 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
    $new_args{$dbslot} = $value;
    $update_args{$dbslot} = $value
 	if ($update && ($required & $SLOT_UPDATE));
+
+    if ($key eq "rspec") {
+	$rspec = $value;
+    }
 }
 UserError()
    if (keys(%errors));
@@ -291,20 +294,29 @@ if ($update) {
    delete($update_args{"description"});

    #
-    # If the rspec changed, then make a new version of the profile.
+    # If the rspec/script changed, then make a new version of the profile.
    # Everything else is metadata.
    #
-    if (exists($update_args{"rspec"})) {
-	if ($update_args{"rspec"} ne $profile->rspec()) {
+    if (exists($update_args{"rspec"}) || exists($update_args{"script"})) {
+	if ((exists($update_args{"rspec"}) &&
+	     $update_args{"rspec"} ne $profile->rspec()) ||
+	    (exists($update_args{"script"}) &&
+	     $update_args{"script"} ne $profile->script())) {
 	    if ($this_user->IsAdmin()) {
 		$profile = $profile->NewVersion($this_user);
 		if (!defined($profile)) {
 		    fatal("Could not create new version of the profile");
 		}
 	    }
-	    $profile->UpdateVersion({"rspec" => $update_args{"rspec"}});
+	    $profile->UpdateVersion({"rspec" => $update_args{"rspec"}})
+		if (exists($update_args{"rspec"}));
+	    $profile->UpdateVersion({"script" => $update_args{"script"}})
+		if (exists($update_args{"script"}));
 	}
-	delete($update_args{"rspec"});
+	delete($update_args{"rspec"})
+	    if (exists($update_args{"rspec"}));
+	delete($update_args{"script"})
+	    if (exists($update_args{"script"}));
    }
    $profile->UpdateMetaData(\%update_args) == 0 or
 	fatal("Could not update profile record");

--- a/apt/rungenilib.in
+++ b/apt/rungenilib.in
+#!/usr/bin/perl -wT
+
+#
+# Copyright (c) 2000-2014 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 Socket;
+use File::Basename;
+use File::Temp qw(tempfile :POSIX );
+use POSIX qw(:signal_h);
+use POSIX ":sys_wait_h";
+
+#
+# Parse an ns file. Since the parser runs arbitrary NS file for the user,
+# this cannot be safely done on boss without jumping through huge hoops
+# to secure tcl and the DB. Yuck! So, instead of running the parser on boss,
+# we run it over on ops. This first version operates like this:
+#
+# NB: This script is setuid.
+#
+sub usage()
+{
+    print STDOUT "Usage: rungenilib [options] infile\n";
+ 
+    exit(-1);
+}
+my $optlist  = "do:";
+my $debug    = 0;
+my $ofile;
+
+#
+# Configure variables
+#
+my $TB       = "@prefix@";
+my $TBOPS    = "@TBOPSEMAIL@";
+my $CONTROL  = "@USERNODE@";
+
+# Locals
+my $SAVEUID  = $UID;
+my $this_user;
+my $file;
+
+# Protos
+sub fatal($);
+
+#
+# Turn off line buffering on output
+#
+$| = 1;
+
+#
+# Untaint the path
+# 
+$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/sbin:/usr/sbin";
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+if ($EUID != 0) {
+    # We don't want to run this script unless its the real version.
+    die("Must be root! Maybe its a development version?");
+}
+
+# This script is setuid, so please do not run it as root. Hard to track
+# what has happened.
+if ($UID == 0) {
+    die("Please do not run this as root! Its already setuid!");
+}
+
+#
+# Testbed Support libraries
+#
+use lib "@prefix@/lib";
+use libdb;
+use libtestbed;
+use User;
+
+#
+# Parse command arguments. Once we return from getopts, all that should
+# left are the required arguments.
+#
+%options = ();
+if (! getopts($optlist, \%options)) {
+    usage();
+}
+if (defined($options{"d"})) {
+    $debug = 1;
+}
+if (defined($options{"o"})) {
+    $ofile = $options{"o"};
+}
+if (@ARGV != 1) {
+    usage();
+}
+$file = $ARGV[0];
+
+#
+# Must taint check!
+#
+if ($file =~ /^([-\w\/\.]+)$/) {
+    $file = $1;
+}
+else {
+    die("Bad data in argument: $file.");
+}
+if (defined($ofile)) {
+    if ($ofile =~ /^([-\w\/\.]+)$/) {
+	$ofile = $1;
+    }
+    else {
+	die("Bad data in argument: $ofile.");
+    }
+}
+
+my $infile   = tmpnam();
+my $outfile  = tmpnam();
+
+#
+# Get DB uid for sending over to ops.
+#
+$this_user = User->ThisUser();
+if (! defined($this_user)) {
+    tbdie("You ($UID) do not exist!");
+}
+# Run as the user for most of this script.
+$EUID = $UID;
+
+# Now append the import file to. This part is hokey. Fix later.
+system("cat $file >> $infile") == 0
+    or fatal("Could not combine defs file and the script file!");
+
+#
+# Touch the output file, to avoid a root owned, 644 file. 
+#
+system("touch $outfile") == 0 or
+    fatal("Could not create $outfile");
+
+#
+# Build up a new command line to run the parser on ops, writing the
+# result back to a file if not in anonmode. Remember to tack on the
+# user ID to flip to, when not in testmode.
+#
+my $cmdargs = "$TB/libexec/rungenilib.proxy -u " . $this_user->uid();
+
+#
+# Run parser, redirecting stdout to a file to capture the parser results.
+# Stderr is redirected to the ERR filehandle
+# Must flip to real root to run ssh.
+#
+$EUID = $UID = 0;
+open ERR, "sshtb -host $CONTROL $cmdargs < $infile 2>&1 >> $outfile |";
+$EUID = $UID = $SAVEUID;
+
+#
+# Now read in the results from stderr.
+#
+my $errs = "";
+while (<ERR>) {
+    $errs .= $_;
+}
+close(ERR);
+my $exit_status = $?;
+
+if ($exit_status) {
+    if (WIFSIGNALED($exit_status)) {
+	# The POSIX module doesn't create constants for valid signals
+	# (including SIGBUS), thus we have to do it the hard way.
+
+	# Get the mapping from signal num. to name
+	use Config;
+	my (%sig_num, @sig_name);
+	my @names = split ' ', $Config{sig_name};
+	@sig_num{@names} = split ' ', $Config{sig_num};
+	foreach (@names) {$sig_name[$sig_num{$_}] ||= $_}
+
+	my $signal  = WTERMSIG($exit_status);
+	my $signame = $sig_name[$signal];
+	
+	if (grep {$_ eq $signame} qw(ILL TRAP EMT FPE BUS SEGV SYS)) {
+	    SENDMAIL($TBOPS, "geni-lib converter Crashed",
+		     "$errs\n",
+		     undef, undef, 
+		     $file);
+	}
+	fatal("Failed to convert genilib script!");
+    }
+    if (defined($ofile)) {
+	if (open(OFILE, "> $ofile")) {
+	    print OFILE $errs;
+	    close(OFILE);
+	}
+    }
+    else {
+	print STDERR $errs;
+    }
+    unlink($outfile);
+    unlink($infile);
+    exit(1);
+}
+if (defined($ofile)) {
+    system("cat $outfile > $ofile");
+}
+else {
+    system("cat $outfile");
+}
+unlink($outfile);
+unlink($infile);
+exit(0);
+
+sub fatal($) {
+    my ($mesg) = $_[0];
+
+    print STDERR "*** $0:\n".
+	         "    $mesg\n";
+    unlink($outfile)
+	if (defined($outfile));
+    unlink($infile)
+	if (defined($infile));
+    exit(-1);
+}
--- a/apt/rungenilib.proxy.in
+++ b/apt/rungenilib.proxy.in
+#!/usr/bin/perl -w
+
+#
+# Copyright (c) 2000-2014 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::Long;
+use BSD::Resource;
+use POSIX qw(:signal_h);
+    
+#
+# Simply a wrapper for the geni-lib python environment
+#
+# When run in "impotent" mode, there is no output, just an exit code. 
+#
+sub usage()
+{
+    print STDOUT
+	"Usage: rungenilib.proxy -u user [args ...]\n".
+        "Where options and arguments are those required by geni-lib\n";
+ 
+    exit(-1);
+}
+
+#
+# Configure variables
+#
+my $TB       = "@prefix@";
+my $TBOPS    = "@TBOPSEMAIL@";
+my $TESTMODE = 0;
+my $GENILIB  = "$TB/lib/geni-lib/";
+my $debug    = 0;
+
+# Locals
+my $tempdir = "/tmp/genilib-$$";
+my $ifile   = "$$.py";
+my $ofile   = "$$.rspec";
+
+my $optlist = "u:v";
+
+#
+# Turn off line buffering on output
+#
+$| = 1;
+
+#
+# Untaint the path
+# 
+$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+$ENV{"PYTHONPATH"} = $GENILIB;
+
+#
+# Testbed Support libraries
+#
+use lib "@prefix@/lib";
+use libtestbed;
+
+my $user;
+
+#
+# Parse command arguments. Once we return from getopts, all that should be
+# left are the required arguments.
+#
+if (! GetOptions("u:s" => \$user)) {
+    usage();
+}
+
+#
+# First option has to be the -u option, the user to run this script as.
+# In testmode, we are not run as root, so run as the current user, and
+# in the current directory (not invoked with ssh in testmode). 
+#
+if (! $TESTMODE) {
+    if ($UID != 0) {
+	die("*** $0:\n".
+	    "    Must be root to run this script!");
+    }
+
+    (undef,undef,$unix_uid) = getpwnam($user) or
+	die("*** $0:\n".
+	    "    No such user $user\n");
+
+    #
+    # Need the entire group list for the user, cause of subgroups, and
+    # cause thats the correct thing to do. Too bad perl does not have a
+    # getgrouplist function like the C library.
+    #
+    my $glist = `id -G $user`;
+    if ($glist =~ /^([\d ]*)$/) {
+	$glist = $1;
+    }
+    else {
+	die("*** $0:\n".
+	    "    Unexpected results from 'id -G $user': $glist\n");
+    }
+
+    # Need to split off the first group and create a proper list for $GUID.
+    my @gglist   = split(" ", $glist);
+    my $unix_gid = $gglist[0];
+    $glist       = "$unix_gid $glist";
+
+    # Flip to user and never go back!
+    $GID            = $unix_gid;
+    $EGID           = $glist;
+    $EUID = $UID    = $unix_uid;
+    $ENV{'USER'}    = $user;
+    $ENV{'LOGNAME'} = $user;
+
+    #
+    # Create the tempdir and chmod it to keep people out.
+    #
+    if (! mkdir($tempdir, 0750)) {
+	die("Could not mkdir $tempdir: $!\n");