Checkpoint image backed dataset work.

apt/APT_Dataset.pm.in

@@ -53,7 +53,7 @@ my $TBOPS         = "@TBOPSEMAIL@";
 my $OURDOMAIN     = "@OURDOMAIN@";
 
 # Debugging
-my $usemydevtree  = 0;
+my $usemydevtree  = 1;
 
 #
 # Lookup by uuid.

apt/APT_Instance.pm.in

@@ -57,6 +57,9 @@ my $GENEXTENDCRED = "$TB/sbin/protogeni/genextendcred";
 my %instances  = ();
 my $debug      = 0;
 
+# Debugging
+my $usemydevtree  = 1;
+
 #
 # Lookup by uuid.
 #
@@ -266,6 +269,28 @@ sub Delete($)
     return 0;
 }
 
+#
+# Lock and unlock operate on the underlying slice.
+#
+sub Lock($)
+{
+    my ($self) = @_;
+    my $slice  = $self->GetGeniSlice();
+    if (!defined($slice)) {
+	return -1;
+    }
+    return $slice->Lock();
+}
+sub Unlock($)
+{
+    my ($self) = @_;
+    my $slice  = $self->GetGeniSlice();
+    if (!defined($slice)) {
+	return -1;
+    }
+    return $slice->UnLock();
+}
+
 sub SetStatus($$)
 {
     my ($self,$status) = @_;
@@ -449,9 +474,10 @@ sub ConsoleURL($$)
 	"credentials" => [$slice_credential->asString(),
 			  $speaksfor_credential->asString()],
     };
+    my $cmurl = $authority->url();
+    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
 
-    return Genixmlrpc::CallMethod($authority->url(),
-				  $context, "ConsoleURL", $args);
+    return Genixmlrpc::CallMethod($cmurl, $context, "ConsoleURL", $args);
 }
 
 #
@@ -510,6 +536,8 @@ sub Terminate($)
 	"slice_urn"   => $slice->urn(),
 	"credentials" => $credentials,
     };
+    my $cmurl = $authority->url();
+    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
 
     #
     # We have to watch for resource busy errors, and retry. For a while
@@ -520,8 +548,7 @@ sub Terminate($)
     my $tries = 10;
     while ($tries) {
 	$response =
-	    Genixmlrpc::CallMethod($authority->url(),
-				   $context, "DeleteSlice", $args);
+	    Genixmlrpc::CallMethod($cmurl, $context, "DeleteSlice", $args);
 
 	# SEARCHFAILED is success.
 	return $response
@@ -615,17 +642,18 @@ sub Extend($$)
 			  $speaksfor_credential->asString(),
 			  $extcred],
     };
+    my $cmurl = $authority->url();
+    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
 
-    return Genixmlrpc::CallMethod($authority->url(),
-				  $context, "RenewSlice", $args);
+    return Genixmlrpc::CallMethod($cmurl, $context, "RenewSlice", $args);
 }
 
 #
 # Create an Image,
 #
-sub CreateImage($$$)
+sub CreateImage($$$;$)
 {
-    my ($self, $sliver_urn, $imagename) = @_;
+    my ($self, $sliver_urn, $imagename, $bsname) = @_;
     my $authority = $self->GetGeniAuthority();
     my $geniuser  = $self->GetGeniUser();
     my $slice     = $self->GetGeniSlice();
@@ -648,9 +676,13 @@ sub CreateImage($$$)
 	"credentials" => [$slice_credential->asString(),
 			  $speaksfor_credential->asString()],
     };
+    $args->{'bsname'} = $bsname
+	if (defined($bsname));
 
-    return Genixmlrpc::CallMethod($authority->url(),
-				  $context, "CreateImage", $args);
+    my $cmurl = $authority->url();
+    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
+    
+    return Genixmlrpc::CallMethod($cmurl, $context, "CreateImage", $args);
 }
 
 #
@@ -678,9 +710,10 @@ sub SliceStatus($)
 	"credentials" => [$slice_credential->asString(),
 			  $speaksfor_credential->asString()],
     };
+    my $cmurl = $authority->url();
+    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
 
-    return Genixmlrpc::CallMethod($authority->url(),
-				  $context, "SliverStatus", $args);
+    return Genixmlrpc::CallMethod($cmurl, $context, "SliverStatus", $args);
 }
 
 #
@@ -708,9 +741,10 @@ sub RestartSliver($@)
 	"credentials" => [$slice_credential->asString(),
 			  $speaksfor_credential->asString()],
     };
+    my $cmurl = $authority->url();
+    $cmurl =~ s/protogeni/protogeni\/stoller/ if ($usemydevtree);
 
-    return Genixmlrpc::CallMethod($authority->url(),
-				  $context, "RestartSliver", $args);
+    return Genixmlrpc::CallMethod($cmurl, $context, "RestartSliver", $args);
 }
 
 # _Always_ make sure that this 1 is at the end of the file...

apt/APT_Profile.pm.in

 #!/usr/bin/perl -wT
 #
-# Copyright (c) 2007-2014 University of Utah and the Flux Group.
+# Copyright (c) 2007-2015 University of Utah and the Flux Group.
 # 
 # {{{EMULAB-LICENSE
 # 

apt/create_instance.in

@@ -225,7 +225,7 @@ if (!defined($cm_authority)) {
     }
 }
 my $cmurl = $cm_authority->url();
-#$cmurl =~ s/protogeni/protogeni\/stoller/;
+$cmurl =~ s/protogeni/protogeni\/stoller/;
 
 my $iscloudlab =
     ($CMURN eq "urn:publicid:IDN+utah.cloudlab.us+authority+cm" ? 1 : 0);

apt/manage_dataset.in

@@ -39,6 +39,7 @@ sub usage()
     print STDERR "Usage: manage_dataset [options --] refresh ...\n";
     print STDERR "Usage: manage_dataset [options --] modify ...\n";
     print STDERR "Usage: manage_dataset [options --] extend ...\n";
+    print STDERR "Usage: manage_dataset [options --] snapshot ...\n";
     exit(-1);
 }
 my $optlist     = "dt:";
@@ -74,9 +75,11 @@ use emutil;
 use User;
 use Project;
 use APT_Dataset;
+use APT_Instance;
 use WebTask;
 use Blockstore;
 use GeniResponse;
+use GeniXML;
 
 # Protos
 sub fatal($);
@@ -86,6 +89,7 @@ sub DoRefresh();
 sub DoRefreshInternal($$);
 sub DoModify();
 sub DoExtend();
+sub DoSnapshot();
 
 #
 # Parse command arguments. Once we return from getopts, all that should be
@@ -143,6 +147,9 @@ elsif ($action eq "modify") {
 elsif ($action eq "extend") {
     exit(DoExtend());
 }
+elsif ($action eq "snapshot") {
+    exit(DoSnapshot());
+}
 else {
     usage();
 }
@@ -155,7 +162,7 @@ sub DoCreate()
 {
     my $usage = sub {
 	print STDERR "Usage: manage_dataset create ".
-	    "[-t type] [-f fstype] [-e expiration] ".
+	    "[-t type] [-f fstype] [-e expiration] [-a am_urn] ".
 	    "[-R global|project] [-W creator|project] ".
 	    "-s size pid/name\n";
 	exit(-1);
@@ -165,13 +172,13 @@ sub DoCreate()
     my $errmsg;
     my $pid;
     my $expires;
-    my $size;
+    my $size = 0;
     my $type = "stdataset";
     my $fstype;
     my $read_access;
     my $write_access;
     
-    my $optlist = "ds:t:e:f:w:p:R:W:";
+    my $optlist = "ds:t:e:f:w:p:R:W:a:";
     my %options = ();
     if (! getopts($optlist, \%options)) {
 	&$usage();
@@ -182,12 +189,16 @@ sub DoCreate()
     if (defined($options{"t"})) {
 	$type = $options{"t"};
 	&$usage()
-	    if (! ($type eq "stdataset" || $type eq "ltdataset"));
+	    if (! ($type eq "stdataset" || $type eq "ltdataset" ||
+		   $type eq "imdataset"));
     }
-    if (defined($options{"f"})) {
-	$fstype = $options{"f"};
-	&$usage()
-	    if ($fstype !~ /^(ext2|ext3|ext4|ufs|ufs2)$/);
+    # We ignore the aggregate urn unless its an imdataset.
+    if ($type eq "imdataset") {
+	if (!exists($options{"a"})) {
+	    print STDERR "Must provide -a opton for imdatasets\n";
+	    &$usage();
+	}
+	$aggregate_urn = $options{"a"};
     }
     if (defined($options{"f"})) {
 	$fstype = $options{"f"};
@@ -225,8 +236,10 @@ sub DoCreate()
 	}
 	$expires = $options{"e"};
     }
+    
     &$usage()
-	if (@ARGV != 1 || !defined($size) ||
+	if (@ARGV != 1 ||
+	    ($type ne "imdataset" && !defined($size)) ||
 	    ($type eq "stdataset" && !defined($expires)));
     my $name = shift(@ARGV);
 
@@ -357,7 +370,7 @@ sub DoCreate()
 #
 sub DoDelete()
 {
-    my $errmsg;
+    my $errmsg = "Could not delete dataset";
     
     if (@ARGV != 1) {
 	fatal("usage: $0 delete pid/name");
@@ -439,6 +452,9 @@ sub DoRefreshInternal($$)
     else {
 	$dataset->Update({"state" => $blob->{"state"}});
     }
+    if ($dataset->type() eq "imdataset") {
+	$dataset->Update({"size" => $blob->{"size"}});
+    }
     return 0;
 }
 
@@ -556,6 +572,104 @@ sub DoExtend()
     fatal($errmsg);
 }
 
+#
+# Snapshot an image backed dataset
+#
+sub DoSnapshot()
+{
+    my $errmsg;
+    
+    my $usage = sub {
+	print STDERR "Usage: manage_dataset snapshot ".
+	    "-i instance -b bsname pid/name nodeid\n";
+	exit(-1);
+    };
+    my $optlist = "b:i:";
+    my %options = ();
+    if (! getopts($optlist, \%options)) {
+	&$usage();
+    }
+    &$usage()
+	if (! (@ARGV == 2 && exists($options{"b"}) && exists($options{"i"})));
+    
+    my $bsname  = $options{"b"};
+    my $token   = shift(@ARGV);
+    my $nodeid  = shift(@ARGV);
+    my $dataset = APT_Dataset->Lookup($token);
+    if (!defined($dataset)) {
+	fatal("No such dataset");
+    }
+    if ($dataset->Lock()) {
+	fatal("dataset is busy, cannot lock it");
+    }
+    if ($dataset->type() ne "imdataset") {
+	$errmsg = "Only image backed datasets supported";
+	goto failed;
+    }
+    my $instance = APT_Instance->Lookup($options{"i"});
+    if (!defined($instance)) {
+	$errmsg = "No such instance";
+	goto failed;
+    }
+    if ($instance->Lock()) {
+	# undef so we do not try to unlock it below.
+	$instance = undef;
+	$errmsg = "instance is busy, cannot lock it";
+	goto failed
+    }
+    my $manifest = GeniXML::Parse($instance->manifest());
+    if (! defined($manifest)) {
+	$errmsg = "Could not parse manifest";
+	goto failed;
+    }
+    my $sliver_urn;
+    my @nodes = GeniXML::FindNodes("n:node", $manifest)->get_nodelist();
+    foreach my $node (@nodes) {
+	my $client_id = GeniXML::GetVirtualId($node);
+	if ($nodeid eq $client_id) {
+	    $sliver_urn = GeniXML::GetSliverId($node);
+	    #
+	    # But check that the bsname is on this node.
+	    #
+	    my $found = 0;
+	    foreach my $blockref
+		(GeniXML::FindNodesNS("n:blockstore", $node,
+				      $GeniXML::EMULAB_NS)->get_nodelist()) {
+		    my $name = GeniXML::GetText("name", $blockref);
+		    if ($name eq $bsname) {
+			$found = 1;
+			last;
+		    }
+	    }
+	    if (!$found) {
+		$errmsg = "No such blockstore $bsname on node $nodeid";
+		goto failed;
+	    }
+	    last;
+	}
+    }
+    if (!defined($sliver_urn)) {
+	$errmsg = "Could not find node '$nodeid' in manifest";
+	goto failed;
+    }
+    my $response = $instance->CreateImage($sliver_urn,
+					  $dataset->dataset_id(), $bsname);
+    if ($response->code() != GENIRESPONSE_SUCCESS) {
+	$errmsg = "SnapshotDataset failed: ". $response->output() . "\n";
+	goto failed;
+    }
+    $dataset->Update({"state" => "busy"});
+    $instance->Unlock();
+    $dataset->Unlock();
+    return 0;
+    
+  failed:
+    $instance->Unlock() if (defined($instance));
+    $dataset->Unlock();
+    # This will set the webtask, see below.
+    fatal($errmsg);
+}
+
 sub fatal($)
 {
     my ($mesg) = @_;

apt/manage_instance.in

@@ -57,7 +57,7 @@ my $TBOPS       = "@TBOPSEMAIL@";
 my $QUICKVM     = "$TB/sbin/protogeni/quickvm";
 
 # Debugging
-my $usemydevtree = 0;
+my $usemydevtree = 1;
 
 #
 # Untaint the path

backend/newimageid_ez.in

-#!/usr/bin/perl -wT
+#!/usr/bin/perl -w
 #
 # Copyright (c) 2000-2015 University of Utah and the Flux Group.
 # 
@@ -180,6 +180,7 @@ else {
 my $SLOT_OPTIONAL	= 0x1;	# The field is not required.
 my $SLOT_REQUIRED	= 0x2;  # The field is required and must be non-null.
 my $SLOT_ADMINONLY	= 0x4;  # Only admins can set this field.
+my $SLOT_OSREQUIRED     = 0x8;  # Required on real OS's not datasets.
 #
 # XXX We should encode all of this in the DB so that we can generate the
 # forms on the fly, as well as this checking code.
@@ -192,13 +193,13 @@ my %xmlfields =
      "pid"		=> ["pid",		$SLOT_REQUIRED],
      "gid"		=> ["gid",		$SLOT_OPTIONAL],
      "description"	=> ["description",	$SLOT_REQUIRED],
-     "loadpart"		=> ["loadpart",		$SLOT_REQUIRED],
-     "OS"		=> ["OS",		$SLOT_REQUIRED],
+     "loadpart"		=> ["loadpart",		$SLOT_OSREQUIRED],
+     "OS"		=> ["OS",		$SLOT_OSREQUIRED],
      "version"		=> ["version",		$SLOT_OPTIONAL,	   ""],
      "path"		=> ["path",		$SLOT_OPTIONAL,    ""],
      "node_id"		=> ["node_id",		$SLOT_OPTIONAL,    ""],
      "osfeatures",	=> ["osfeatures",	$SLOT_OPTIONAL,	   ""],
-     "op_mode",		=> ["op_mode",		$SLOT_REQUIRED],
+     "op_mode",		=> ["op_mode",		$SLOT_OSREQUIRED],
      "mtype_*"		=> ["mtype",		$SLOT_OPTIONAL],
      "wholedisk",	=> ["wholedisk",	$SLOT_OPTIONAL,    0],
      "max_concurrent",	=> ["max_concurrent",	$SLOT_OPTIONAL,    0],
@@ -212,6 +213,7 @@ my %xmlfields =
      "hash",		=> ["hash",		$SLOT_ADMINONLY],
      "nextosid",	=> ["nextosid",		$SLOT_ADMINONLY],
      "def_parentosid",	=> ["def_parentosid",	$SLOT_OPTIONAL],
+     "isdataset",	=> ["isdataset",	$SLOT_OPTIONAL],
 );
 
 #
@@ -231,6 +233,13 @@ fatal($@)
 #
 my %errors = ();
 
+# Image backed datasets are special.
+my $isdataset = 0;
+if (exists($xmlparse->{'attribute'}->{"isdataset"}) &&
+    $xmlparse->{'attribute'}->{"isdataset"}->{'value'}) {
+    $isdataset = 1;
+}
+
 #
 # Make sure all the required arguments were provided.
 #
@@ -239,7 +248,8 @@ foreach $key (keys(%xmlfields)) {
     my (undef, $required, undef) = @{$xmlfields{$key}};
 
     $errors{$key} = "Required value not provided"
-	if ($required & $SLOT_REQUIRED  &&
+	if (($required & $SLOT_REQUIRED ||
+	     ($required & $SLOT_OSREQUIRED && !$isdataset)) &&
 	    ! exists($xmlparse->{'attribute'}->{"$key"}));
 }
 UserError()
@@ -299,7 +309,7 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
 	    }
 	}
 	if (!$wild) {