Checkpoint dataset and image changes. APT becomes the default for

all users. Cloudlab added to the list, but not exposed except to
admins and studly users.

apt/APT_Dataset.pm.in

@@ -440,7 +440,7 @@ sub CreateDataset($)
 	if (defined($self->expires()));
 
     my $cmurl = $authority->url();
-#    $cmurl =~ s/protogeni/protogeni\/stoller/;
+    $cmurl =~ s/protogeni/protogeni\/stoller/;
 
     return Genixmlrpc::CallMethod($cmurl, $context, "CreateDataset", $args);
 }
@@ -471,7 +471,7 @@ sub DeleteDataset($)
 			  $speaksfor_credential->asString()],
     };
     my $cmurl = $authority->url();
-#    $cmurl =~ s/protogeni/protogeni\/stoller/;
+    $cmurl =~ s/protogeni/protogeni\/stoller/;
 
     return Genixmlrpc::CallMethod($cmurl, $context, "DeleteDataset", $args);
 }
@@ -502,7 +502,7 @@ sub DescribeDataset($)
 			  $speaksfor_credential->asString()],
     };
     my $cmurl = $authority->url();
-#    $cmurl =~ s/protogeni/protogeni\/stoller/;
+    $cmurl =~ s/protogeni/protogeni\/stoller/;
 
     return Genixmlrpc::CallMethod($cmurl, $context, "DescribeDataset", $args);
 }

apt/APT_Geni.pm.in

@@ -53,6 +53,8 @@ sub GenCredentials($$;$)
 {
     my ($target, $geniuser, $privs) = @_;
     my ($speaksfor, $credential);
+    # If the caller does not want a speaksfor, do not generate.
+    my $wantspeaksfor = wantarray;
 
     my $speaker_signer = $GeniCredential::LOCALSA_FLAG;
     #
@@ -64,21 +66,6 @@ sub GenCredentials($$;$)
 	$speaker_signer = "/usr/testbed/etc/utah-apt.sa";
     }
 
-    #
-    # The Utah SA is always the speaker, even if the user is a guest
-    # with the alternate CA.
-    #
-    my $sa_certificate = GeniCertificate->LoadFromFile($SACERT);
-    if (!defined($sa_certificate)) {
-	print STDERR "Could not load certificate from $SACERT\n";
-	goto bad;
-    }
-    my $sa_authority = GeniAuthority->Lookup($sa_certificate->urn());
-    if (!defined($sa_authority)) {
-	prnt STDERR "Could not load SA authority object\n";
-	goto bad;
-    }
-
     #
     # If a local user account, but a nonlocal id, then we should
     # have a speaksfor credential stored, as well as a certificate
@@ -92,10 +79,12 @@ sub GenCredentials($$;$)
 	    print STDERR "No stored speaksfor/certificate for $geniuser\n";
 	    goto bad;
 	}
-	$speaksfor = GeniCredential->CreateFromSigned($speaksfor_string);
-	if (!defined($speaksfor)) {
-	    print STDERR "Could not create speaksfor credential\n";
-	    goto bad;
+	if ($wantspeaksfor) {
+	    $speaksfor = GeniCredential->CreateFromSigned($speaksfor_string);
+	    if (!defined($speaksfor)) {
+		print STDERR "Could not create speaksfor credential\n";
+		goto bad;
+	    }
 	}
 	my $certificate =
 	    GeniCertificate->LoadFromString($certificate_string);
@@ -106,15 +95,31 @@ sub GenCredentials($$;$)
 	$credential = GeniCredential->Create($target, $certificate);
     }
     else {
-	$speaksfor = GeniCredential->Create($geniuser, $sa_authority);
-	if (!defined($speaksfor)) {
-	    print STDERR "Could not create speaksfor credential\n";
-	    goto bad;
-	}
-	$speaksfor->SetType("speaksfor");
-	if ($speaksfor->Sign($speaker_signer)) {
-	    print STDERR "Could not sign speaksfor credential\n";
-	    goto bad;
+	if ($wantspeaksfor) {
+	    #
+	    # The Utah SA is always the speaker, even if the user is a guest
+	    # with the alternate CA.
+	    #
+	    my $sa_certificate = GeniCertificate->LoadFromFile($SACERT);
+	    if (!defined($sa_certificate)) {
+		print STDERR "Could not load certificate from $SACERT\n";
+		goto bad;
+	    }
+	    my $sa_authority = GeniAuthority->Lookup($sa_certificate->urn());
+	    if (!defined($sa_authority)) {
+		prnt STDERR "Could not load SA authority object\n";
+		goto bad;
+	    }
+	    $speaksfor = GeniCredential->Create($geniuser, $sa_authority);
+	    if (!defined($speaksfor)) {
+		print STDERR "Could not create speaksfor credential\n";
+		goto bad;
+	    }
+	    $speaksfor->SetType("speaksfor");
+	    if ($speaksfor->Sign($speaker_signer)) {
+		print STDERR "Could not sign speaksfor credential\n";
+		goto bad;
+	    }
 	}
 	$credential = GeniCredential->Create($target, $geniuser);
     }
@@ -134,7 +139,10 @@ sub GenCredentials($$;$)
 	print STDERR "Could not sign $target credential\n";
 	goto bad;
     }
-    return ($credential, $speaksfor);
+    if (wantarray) {
+	return ($credential, $speaksfor);
+    }
+    return $credential;
   bad:
     return ();
 }

apt/create_instance.in

@@ -46,8 +46,7 @@ sub usage()
 my $optlist = "dvu:a:t:f";
 my $debug   = 0;
 my $verbose = 1;
-my $utahddc = 1;
-my $DDCURN  = "urn:publicid:IDN+utahddc.geniracks.net+authority+cm";
+my $DEFAULT_URN  = "urn:publicid:IDN+utahddc.geniracks.net+authority+cm";
 my $xmlfile;
 my $webtask;
 my $webtask_id;
@@ -63,6 +62,7 @@ sub fatal($);
 sub UserError($);
 sub SnapShot($$$);
 sub GenCredentials($$$$);
+sub CreateDatasetCreds($$$$$);
 
 #
 # Configure variables
@@ -96,6 +96,7 @@ use libaudit;
 use APT_Profile;
 use APT_Instance;
 use APT_Geni;
+use APT_Dataset;
 use User;
 use OSinfo;
 use emutil;
@@ -211,15 +212,8 @@ my $CMURN;
 if (defined($aggregate)) {
     $CMURN = $aggregate;
 }
-elsif ($utahddc) {
-    $CMURN = $DDCURN;
-}
 else {
-    my $cm_certificate = GeniCertificate->LoadFromFile($CMCERT);
-    if (!defined($cm_certificate)) {
-	fatal("Could not load certificate from $CMCERT\n");
-    }
-    $CMURN = $cm_certificate->urn();
+    $CMURN = $DEFAULT_URN;
 }
 my $cm_authority = GeniAuthority->Lookup($CMURN);
 if (!defined($cm_authority)) {
@@ -228,6 +222,8 @@ if (!defined($cm_authority)) {
 	fatal("Could not load CM authority object");
     }
 }
+my $cmurl = $cm_authority->url();
+#$cmurl =~ s/protogeni/protogeni\/stoller/;
 
 #
 # Must wrap the parser in eval since it exits on error.
@@ -283,10 +279,43 @@ my $profile_object = APT_Profile->Lookup($value);
 if (!defined($profile_object)) {
     fatal("No such profile: $value");
 }
+#
+# Temp hack; replace URNs with URLs.
+#
+if (1 && $profile_object->ConvertDiskImages()) {
+    fatal("Not able to convert disk_image URNs to URLs.");
+}
 my $rspecstr = $profile_object->CheckFirewall(!$localuser);
 $profile = $profile_object->profileid();
 $version = $profile_object->version();
 
+#
+# Look for datasets; need to verify that the datasets being referenced
+# still exist and are still permissible to use, and we have to generate
+# credentials for those datasets (if not a global dataset). The tricky
+# aspect is that while a dataset and a profile have project permissions,
+# the experiment has no project association, so if the profile/dataset
+# perms are okay, then we send over a credential that tells the CM to
+# allow this experiment to use that dataset in that project. 
+#
+my $errmsg = "Bad dataset";
+if (APT_Profile::CheckDatasets($rspecstr, $profile_object->pid(), \$errmsg)) {
+    UserError($errmsg);
+}
+
+#
+# A temporary hack to make sure that the user does not try to run
+# an x386 image on the Cloudlab cluster (ARMs). This will eventually
+# get replaced with Jon's constraint checking code.
+#
+my $iscloudlab =
+    ($CMURN eq "urn:publicid:IDN+utah.cloudlab.us+authority+cm" ? 1 : 0);
+
+if ($profile_object->CheckImageConstraints($iscloudlab, \$errmsg)) {
+    UserError($errmsg);
+}
+fatal("fooey");
+
 #
 # Use ssh-keygen to see if the key is valid and convertable. We first
 # try to get the fingerprint, which will tells us if its already in
@@ -470,6 +499,15 @@ if ($geniuser->GetKeyBundle(\@sshkeys, 1) < 0 || !@sshkeys) {
     fatal("No ssh keys to use for $geniuser!");
 }
 
+# Generate the extra credentials that tells the backend this experiment
+# can access the datasets.
+my @dataset_credentials = ();
+if (CreateDatasetCreds($rspecstr,
+		       $profile_object->pid(), $geniuser, 
+		       \$errmsg, \@dataset_credentials)) {
+    fatal($errmsg);
+}
+
 #
 # Now generate a slice registration and credential
 #
@@ -583,7 +621,7 @@ $webtask->SetProcessID($PID)
 # This creates the sliver and starts it.
 #
 my $response =
-    Genixmlrpc::CallMethod($cm_authority->url(), undef,
+    Genixmlrpc::CallMethod($cmurl, undef,
 			   "CreateSliver",
 			   { "slice_urn"   => $slice_urn,
 			     "rspec"       => $rspecstr,
@@ -593,7 +631,9 @@ my $response =
 				   'keys'  => \@sshkeys }],
 			     "credentials" =>
 				 [$slice_credential->asString(),
-				  $speaksfor_credential->asString()]});
+				  $speaksfor_credential->asString(),
+				  @dataset_credentials
+				 ]});
 
 if (!defined($response) || $response->code() != GENIRESPONSE_SUCCESS) {
     $slice->Delete();
@@ -638,7 +678,7 @@ while ($seconds > 0) {
     $seconds -= $interval;
     
     my $response =
-	Genixmlrpc::CallMethod($cm_authority->url(), undef,
+	Genixmlrpc::CallMethod($cmurl, undef,
 			       "SliverStatus",
 			       { "slice_urn"   => $slice_urn,
 				 "credentials" =>
@@ -698,6 +738,65 @@ else {
 $slice->UnLock();
 exit(0);
 
+#
+# Create credentials to access datasets.
+#
+sub CreateDatasetCreds($$$$$)
+{
+    my ($xml, $pid, $user, $pmsg, $pref) = @_;
+    my @credentials = ();
+    
+    my $rspec = GeniXML::Parse($xml);
+    if (! defined($rspec)) {
+	print STDERR "CreateDatasetCreds: 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);
+
+	    #
+	    # We only care about datasets here, we let the backend
+	    # do the error checking on ephemeral blockstores.
+	    #
+	    next
+		if (!defined($leaseurn));
+	    
+	    my ($authority, $type, $id) = GeniHRN::Parse($leaseurn);
+	    #
+	    # Separate project from name; this is how the rspec specifies
+	    # the dataset they want, since it might be in another project
+	    #
+	    if ($id =~ /^([-\w]+)\/\/(.+)$/) {
+		$pid = $1;
+		$id  = $2;
+	    }
+	    my $dataset = APT_Dataset->Lookup("$pid/$id");
+	    if (!defined($dataset)) {
+		$$pmsg = "Persistent dataset '$pid/$id' does not exist";
+		return 1;
+	    }
+	    my $certificate = $dataset->GetCertificate();
+	    if (!defined($certificate)) {
+		$$pmsg = "No certificate for dataset '$pid/$id'";
+		return -1;
+	    }
+	    my $credential =
+		APT_Geni::GenCredentials($certificate, $geniuser,
+					 ["blockstores"]);
+	    if (!defined($credential)) {
+		$$pmsg = "Could not create credential for dataset '$pid/$id'";
+		return -1;
+	    }
+	    push(@credentials, $credential->asString());
+	}
+    }
+    @$pref = @credentials;
+    return 0;
+}
+
 sub fatal($) {
     my ($mesg) = $_[0];
 

apt/manage_dataset.in

@@ -157,7 +157,7 @@ sub DoCreate()
     my $type = "stdataset";
     my $fstype;
     
-    my $optlist = "ds:t:e:f:";
+    my $optlist = "ds:t:e:f:w:";
     my %options = ();
     if (! getopts($optlist, \%options)) {
 	&$usage();
@@ -387,7 +387,12 @@ sub DoRefreshInternal($$)
     
     my $response = $dataset->DescribeDataset();
     if ($response->code() != GENIRESPONSE_SUCCESS) {
-	$$pmesg = "DescribeDataset failed: ". $response->output() . "\n";
+	if ($response->code() != GENIRESPONSE_SEARCHFAILED) {
+	    $$pmesg = "Dataset no longer exists at the target\n";
+	}
+	else {
+	    $$pmesg = "DescribeDataset failed: ". $response->output() . "\n";
+	}
 	return -1;
     }
     my $blob = $response->value();

apt/manage_instance.in

@@ -159,7 +159,8 @@ sub DoSnapshot()
     if (!defined($slice)) {
 	fatal("No slice for quick VM: $uuid");
     }
-
+    my $authority = $instance->GetGeniAuthority();
+    
     # The web interface (and in the future the xmlrpc interface) sets this.
     my $this_user = User->ImpliedUser();
     if (! defined($this_user)) {
@@ -171,9 +172,9 @@ sub DoSnapshot()
     
     #
     # If we get an imagename on the command line, the caller is
-    # saying it is responsible. If we do not get one, we create
-    # the name and update the underlying profile with the new image
-    # urn.
+    # saying it is responsible (clone). If we do not get one, we
+    # create the name and update the underlying profile with the new
+    # image urn.
     #
     my $imagename;
     my $node_id;
@@ -202,16 +203,17 @@ sub DoSnapshot()
     if (! defined($manifest)) {
 	fatal("Could not parse manifest");
     }
+    my $node;
     my @nodes = GeniXML::FindNodes("n:node", $manifest)->get_nodelist();
     if (!defined($node_id)) {
 	if (@nodes != 1) {
 	    fatal("Too many nodes (> 1) to snapshot");
 	}
-	my ($node)     = @nodes;
+	($node)     = @nodes;
 	$sliver_urn = GeniXML::GetSliverId($node);
     }
     else {
-	foreach my $node (@nodes) {
+	foreach $node (@nodes) {
 	    my $client_id = GeniXML::GetVirtualId($node);
 	    if ($node_id eq $client_id) {
 		$sliver_urn = GeniXML::GetSliverId($node);
@@ -222,11 +224,6 @@ sub DoSnapshot()
 	    fatal("Could not find node '$node_id' in manifest");
 	}
     }
-    if ($slice->Lock()) {
-	fatal("Slice is busy, cannot lock it");
-    }
-    $needunlock = 1;
-    
     #
     # Create the webtask object.
     #
@@ -236,7 +233,50 @@ sub DoSnapshot()
 	$webtask->AutoStore(1);
     }
 
-    my $authority = $instance->GetGeniAuthority();
+    #
+    # Really, a snapshot and not a clone. We are not going to allow this
+    # if the instance in on a different cluster then where the image was
+    # originally created, since otherwise the image provenance will look
+    # like spaghetti.
+    #
+    if ($update_profile) {
+	my $diskref = GeniXML::GetDiskImage($node);
+	if (defined($diskref)) {
+	    my $image_url = GeniXML::GetText("url", $diskref);
+	    if (defined($image_url)) {
+		require URI;
+
+		# Get the hostname for the image URL.
+		my $uri = URI->new($image_url);
+		if (!defined($uri)) {
+		    fatal("Could not parse $image_url");
+		}
+		my $image_host = $uri->host();
+
+		# Get the hostname for the authority.
+		$uri = URI->new($authority->url());
+		if (!defined($uri)) {
+		    fatal("Could not parse authority URL");
+		}
+		my $authority_host = $uri->host();
+
+		# Compare domains.
+		$image_host =~ s/^([^.]+\.)//;
+		$authority_host =~ s/^([^.]+\.)//;
+	
+		if ($image_host ne $authority_host) {
+		    $errmsg  = "Not allowed to take a snapshot on this cluster";
+		    $errcode = 1;
+		    goto bad;
+		}
+	    }
+	}
+    }
+    if ($slice->Lock()) {
+	fatal("Slice is busy, cannot lock it");
+    }
+    $needunlock = 1;
+    
     my $geniuser  = $instance->GetGeniUser();
     my $context   = APT_Geni::GeniContext();
     if (! (defined($geniuser) && defined($authority) &&
@@ -411,7 +451,7 @@ sub DoSnapshot()
 		exit(1);
 	    }
 	}
-	$profile->UpdateDiskImage($image_urn);
+	$profile->UpdateDiskImage($version_url);
     }
     $instance->SetStatus("ready");
     # We garbage collect these later, so anyone waiting has a chance
@@ -428,7 +468,8 @@ sub DoSnapshot()
 	$webtask->Exited($errcode);
 	$webtask->output($errmsg);
     }
-    $slice->UnLock();
+    $slice->UnLock()
+	if ($needunlock);
     if (defined($logfile)) {
 	$instance->Brand()->SendEmail($instance->Brand()->OpsEmailAddress(),
 				      "Snapshot failed",

apt/manage_profile.in

@@ -266,6 +266,15 @@ elsif (!$project->AccessCheck($this_user, TB_PROJECT_MAKEIMAGEID())) {
     $errors{"profile_pid"} = "Not enough permission in this project";
 }
 
+# Check datasets.
+if (defined($rspec)) {
+    my $errmsg = "Bad dataset";
+    if (APT_Profile::CheckDatasets($rspec, $project->pid(), \$errmsg)) {
+	$errors{"error"} = $errmsg;
+	UserError();
+    }
+}
+
 #
 # Are we going to snapshot a node in an experiment? If so we
 # sanity check to make sure there is just one node. 
@@ -400,9 +409,9 @@ if (defined($instance)) {
     # The script helpfully put the new image urn in the webtask.
     #
     $webtask->Refresh();
-    my $image_urn = $webtask->image_urn();
-    if (!defined($image_urn) ||
-	$profile->UpdateDiskImage($image_urn)) {
+    my $image_url = $webtask->image_url();
+    if (!defined($image_url) ||
+	$profile->UpdateDiskImage($image_url)) {
 	$webtask->Delete()
 	    if (!defined($webtask_id));
 	$profile->Delete(1);

protogeni/lib/GeniCM.pm.in

@@ -476,10 +476,10 @@ sub GetTicket($;$)
 			$rspecstr, $isupdate, $impotent, 0, 1, $ticket);
 }
 
-sub GetTicketAux($$$$$$$$)
+sub GetTicketAux($$$$$$$$@)
 {
     my ($credential, $rspecstr, $isupdate, $impotent, $v2, $level,
-	$ticket, $speaksfor) = @_;
+	$ticket, $speaksfor, @morecreds) = @_;
     
     defined($credential) &&
 	($credential->HasPrivilege( "pi" ) or
@@ -522,7 +522,7 @@ sub GetTicketAux($$$$$$$$)
     
     return GetTicketAuxAux($slice, $user, $rspecstr,
 			   $isupdate, $impotent, $v2, $level, $ticket,
-			   [$credential], $speaksfor);
+			   [$credential, @morecreds], $speaksfor);
 }
 sub GetTicketAuxAux($$$$$$$$$$)
 {
@@ -1687,7 +1687,8 @@ sub GetTicketAuxAux($$$$$$$$$$)
 						   $ref,
 				   $GeniXML::EMULAB_NS)->get_nodelist()) {
 	    $response = HandleBlockstore($slice_experiment, $virtexperiment,
-					 $user, $ref, $blockref);
+					 $user, $slice, $ref,
+					 $blockref, @$credentials);
 	    goto bad
 		if (GeniResponse::IsError($response));
 	}
@@ -6740,11 +6741,14 @@ sub SetSliceExpiration($$$$@)
 #
 # Handle BlockStores. 
 #
-sub HandleBlockstore($$$$)
+sub HandleBlockstore($$$$$$@)
 {
-    my ($experiment, $virtexperiment, $geniuser, $noderef, $blockref) = @_;
-    my $message  = "Unknown Error";
-    my $nodename = GeniXML::GetVirtualId($noderef);
+    my ($experiment, $virtexperiment,
+	$geniuser, $slice, $noderef, $blockref, @credentials) = @_;
+    my $errorcode = GENIRESPONSE_ERROR;
+    my $message   = "Unknown Error";
+    my $nodename  = GeniXML::GetVirtualId($noderef);
+    
     require Lease;
     require Blockstore;
 
@@ -6772,21 +6776,6 @@ sub HandleBlockstore($$$$)
 	$message = "Missing blockstore mount point";
 	goto bad;
     }
-    if (defined($leasename)) {
-	if (GeniHRN::IsValid($leasename)) {
-	    my (undef,$type,$id) = GeniHRN::Parse($leasename);
-	    if ($type ne "dataset") {
-		$message = "Illegal persistent urn for $bsname";
-		goto bad;
-	    }
-	    $leasename = $id;
-	}
-	if (!TBcheck_dbslot($leasename, "project_leases", "lease_id",
-			    TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
-	    $message = "Illegal persistent name for $bsname";
-	    goto bad;
-	}
-    }
     if (!defined($readonly)) {
 	$readonly = 0;
     }
@@ -6820,31 +6809,112 @@ sub HandleBlockstore($$$$)
 	$fixed = $bsname = $nodename;
 	push(@attributes, ["protocol", "iSCSI", 1]);
 
-	#
-	# Look for a lease name (persistent).
-	#
 	if (defined($leasename)) {
-	    my $lease = Lease->Lookup($experiment->pid(), $leasename);
+	    # Default project to lookup lease.
+	    my $pid = $experiment->pid();
+	    my $gid = $pid;
+	
+	    #
+	    # Look for a urn and possibly project qualified lease name.
+	    #
+	    if (GeniHRN::IsValid($leasename)) {
+		my (undef,$type,$id) = GeniHRN::Parse($leasename);
+		if ($type ne "dataset") {
+		    $message = "Illegal dataset urn for $leasename";
+		    goto bad;
+		}
+		$leasename = $id;
+
+		if ($leasename =~ /^(.*)\/\/(.*)$/) {
+		    $gid = $1;
+		    $leasename = $2;
+		}
+		if (!TBcheck_dbslot($leasename, "project_leases", "lease_id",
+				TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
+		    $message = "Illegal dataset name: $leasename";
+		    goto bad;
+		}
+	    }
+	    my $lease = Lease->Lookup($pid, $gid, $leasename);
 	    if (!defined($lease)) {
 		#
 		# Dataset must already exist.
 		#
 		$message = "No such persistent dataset for $bsname: $leasename";
+		$errorcode = GENIRESPONSE_SEARCHFAILED;
 		goto bad;
 	    }
+	    # Local user can use their own local lease. 
+	    goto permokay
+		if ($geniuser->IsLocal() &&
+		    $lease->owner_uid() eq $geniuser->uid());
+	    
+	    #
+	    # Permission checks are a work in progress. Datasets created by
+	    # the same authority domain as the slice can be used. This is
+	    # explicit in the slice pid/gid and the lease pid/gid, which
+	    # reflect the domains.
+	    #
+	    if ($experiment->pid() ne $lease->pid()) {
+		$message = "Not allowed to use dataset from a ".
+		    "different SA: $leasename";
+		$errorcode = GENIRESPONSE_FORBIDDEN;
+		goto bad;
+	    }
+	    # Same SA, same project (subauth). Always allowed.
+	    goto permokay
+		if ($experiment->pid() eq $lease->pid() &&
+		    $experiment->gid() eq $lease->gid());
+
+	    #
+	    # Okay, same pid (SA) but different group (sub authority).
+	    # Must have a credential from the SA that says its okay.
+	    #
+	    my $manager_urn = $lease->GetAttribute("manager_urn");
+	    next
+		if (!defined($manager_urn));
+	    my ($manager_domain) = GeniHRN::Parse($manager_urn);
+	    
+	    foreach my $credential (@credentials) {
+		next
+		    if (!$credential->HasActualPrivilege("blockstores"));
+
+		my ($domain, $type, $id) =
+		    GeniHRN::Parse($credential->target_urn());
+
+		goto permokay
+		    if ($domain eq $manager_domain &&
+			$id eq $lease->lease_id());
+
+	    }
+	    # If we get here, its not allowed.
+	    $message = "No permission to use dataset $leasename";
+	    $errorcode = GENIRESPONSE_FORBIDDEN;
+	    goto bad;
+
+	  permokay:
+	    #
+	    # We do not have shared readonly leases yet, so if the lease
+	    # is in use by another experiment, we have to fail.
+	    #
+	    if ($lease->InUse()) {
+		# This will always be one for now.
+		my ($exptidx) = @{ $lease->UsingResources() };
+		if (defined($exptidx) && $exptidx != $experiment->idx()) {
+		    $message = "Dataset $leasename is already in use";
+		    goto bad;
+		}
+	    }
+	    # We need some stuff from the blockstore to fill out the
+	    # virt tables below.
 	    my $blockstore = Blockstore->LookupByLease($lease->lease_idx());
 	    if (!defined($blockstore)) {
 		$message = "Could not get blockstore for lease $leasename";
 		goto bad;
 	    }
-		
 	    $type = $lease->type();
 	    $size = $blockstore->total_size();
-	    #
-	    # TODO!!!! Lease permission checks. Complicated by the
-	    # fact that geniusers are not real users, and the datasets
-	    # are created by geniuser. 
-	    #
+
 	    push(@attributes, ["lease", $lease->lease_idx(), 1]);
 	}
     }
@@ -6902,7 +6972,7 @@ sub HandleBlockstore($$$$)
     return 0;
 
   bad:
-    return GeniResponse->Create(GENIRESPONSE_ERROR, undef, $message);
+    return GeniResponse->Create($errorcode, undef, $message);
 }
 
 # _Always_ make sure that this 1 is at the end of the file...

protogeni/lib/GeniCMV2.pm.in

@@ -407,7 +407,8 @@ sub CreateSliver($)
     if (! GeniHRN::IsValid($slice_urn)) {
 	return GeniResponse->MalformedArgsResponse("Bad characters in URN");
     }
-    my ($credential,$speaksfor) = GeniStd::CheckCredentials($credentials);
+    my ($credential,$speaksfor,@morecreds) =
+	GeniStd::CheckCredentials($credentials);
     return $credential
 	if (GeniResponse::IsResponse($credential));
 
@@ -463,7 +464,8 @@ sub CreateSliver($)
 	}
     }
     my $rspec = GeniCM::GetTicketAux($credential, $rspecstr,
-				     0, $impotent, 1, 0, undef, $speaksfor);
+				     0, $impotent, 1, 0,
+				     undef, $speaksfor, @morecreds);
     return $rspec
 	if (GeniResponse::IsResponse($rspec));
 
@@ -3231,7 +3233,11 @@ sub CreateDataset($)
     my $user = GeniUser->Lookup($credential->owner_cert()->urn(), 1);
     return GeniResponse->Create(GENIRESPONSE_FORBIDDEN)
 	if (! ((defined($user) && $user->IsLocal()) ||