#!/usr/bin/perl -wT # # GENIPUBLIC-COPYRIGHT # Copyright (c) 2008-2009 University of Utah and the Flux Group. # All rights reserved. # package GeniCM; # # The server side of the CM interface on remote sites. Also communicates # with the GMC interface at Geni Central as a client. # use strict; use Exporter; use vars qw(@ISA @EXPORT); @ISA = "Exporter"; @EXPORT = qw ( ); # Must come after package declaration! use lib '@prefix@/lib'; use GeniDB; use Genixmlrpc; use GeniResponse; use GeniTicket; use GeniCredential; use GeniCertificate; use GeniSlice; use GeniAggregate; use GeniAuthority; use GeniSliver; use GeniUser; use GeniRegistry; use GeniUtil; use GeniHRN; use libtestbed qw(SENDMAIL); use emutil; # Hate to import all this crap; need a utility library. use libdb qw(TBGetSiteVar EXPTSTATE_SWAPPED EXPTSTATE_ACTIVE); use User; use Node; use libadminctrl; use Interface; use English; use Data::Dumper; use XML::Simple; use Date::Parse; use POSIX qw(strftime tmpnam); use Time::Local; use Experiment; use VirtExperiment; use Firewall; # Configure variables my $TB = "@prefix@"; my $TBOPS = "@TBOPSEMAIL@"; my $TBAPPROVAL = "@TBAPPROVALEMAIL@"; my $TBAUDIT = "@TBAUDITEMAIL@"; my $BOSSNODE = "@BOSSNODE@"; my $OURDOMAIN = "@OURDOMAIN@"; my $PGENIDOMAIN = "@PROTOGENI_DOMAIN@"; my $CREATEEXPT = "$TB/bin/batchexp"; my $ENDEXPT = "$TB/bin/endexp"; my $NALLOC = "$TB/bin/nalloc"; my $NFREE = "$TB/bin/nfree"; my $AVAIL = "$TB/sbin/avail"; my $PTOPGEN = "$TB/libexec/ptopgen"; my $TBSWAP = "$TB/bin/tbswap"; my $SWAPEXP = "$TB/bin/swapexp"; my $PLABSLICE = "$TB/sbin/plabslicewrapper"; my $NAMEDSETUP = "$TB/sbin/named_setup"; my $VNODESETUP = "$TB/sbin/vnode_setup"; my $GENTOPOFILE = "$TB/libexec/gentopofile"; my $MAPPER = "$TB/bin/mapper"; my $VTOPGEN = "$TB/bin/vtopgen"; my $SNMPIT = "$TB/bin/snmpit"; my $PRERENDER = "$TB/libexec/vis/prerender"; my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem"; # # Respond to a Resolve request. # sub Resolve($) { my ($argref) = @_; my $uuid = $argref->{'uuid'}; my $cred = $argref->{'credential'}; my $type = lc( $argref->{'type'} ); my $hrn = $argref->{'hrn'}; if (! defined($cred)) { return GeniResponse->MalformedArgsResponse(); } if( defined( $hrn ) && GeniHRN::IsValid( $hrn ) ) { my ($auth,$t,$id) = GeniHRN::Parse( $hrn ); return GeniResponse->Create( GENIRESPONSE_ERROR, undef, "Authority mismatch" ) if( $auth ne $OURDOMAIN ); $type = lc( $t ); $hrn = $id; } if (! (defined($type) && ($type =~ /^(node)$/))) { return GeniResponse->MalformedArgsResponse(); } # Allow lookup by uuid or hrn. if (! defined($uuid) && !defined( $hrn ) ) { return GeniResponse->MalformedArgsResponse(); } if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) { return GeniResponse->MalformedArgsResponse(); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } # # Make sure the credential was issued to the caller, but no special # permission required to resolve component resources. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } if ($type eq "node") { my $node; if (defined($uuid)) { $node= Node->Lookup($uuid); } else { # # We only want the last token for node lookup. # if ($hrn =~ /\./) { ($hrn) = ($hrn =~ /\.([-\w]*)$/); } $node= Node->Lookup($hrn); } if (!defined($node)) { return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef, "Nothing here by that name"); } # Return a blob. my $blob = { "hrn" => "${PGENIDOMAIN}." . $node->node_id(), "uuid" => $node->uuid(), "role" => $node->role(), "hostname" => $node->node_id() . ".${OURDOMAIN}", "physctrl" => Interface->LookupControl( $node->phys_nodeid() )->IP(), "urn" => GeniHRN::Generate( $OURDOMAIN, "node", $node->node_id() ) }; # # Get the list of interfaces for the node. # my @interfaces; if ($node->AllInterfaces(\@interfaces) != 0) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not get interfaces for $uuid"); } my @iblobs = (); foreach my $interface (@interfaces) { next if (!defined($interface->switch_id())); my $urn = GeniHRN::GenerateInterface( $OURDOMAIN, $node->node_id(), $interface->iface() ); my $iblob = { "uuid" => $interface->uuid(), "iface" => $interface->iface(), "type" => $interface->type(), "card" => $interface->card(), "port" => $interface->port(), "role" => $interface->role(), "IP" => $interface->IP() || "", "mask" => $interface->mask() || "", "MAC" => $interface->mac(), "switch_id" => "${OURDOMAIN}." . $interface->switch_id(), "switch_card" => $interface->switch_card(), "switch_port" => $interface->switch_port(), "wire_type" => $interface->wire_type(), "urn" => $urn }; push(@iblobs, $iblob); } $blob->{'interfaces'} = \@iblobs if (@iblobs); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob); } return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED); } # # Discover resources on this component, returning a resource availablity spec # sub DiscoverResources($) { my ($argref) = @_; my $credential = $argref->{'credential'}; my $user_uuid = $ENV{'GENIUSER'}; $credential = GeniCredential->CreateFromSigned($credential); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } # The credential owner/slice has to match what was provided. if ($user_uuid ne $credential->owner_uuid()) { return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Invalid credentials for operation"); } # # A sitevar controls whether external users can get any nodes. # my $allow_externalusers = 0; if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){ # Cannot get the value, say no. $allow_externalusers = 0; } if (!$allow_externalusers) { my $user = GeniUser->Lookup($user_uuid, 1); # No record means the user is remote. if (!defined($user) || !$user->IsLocal()) { return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef, "External users temporarily denied"); } } # # Use ptopgen in xml mode to spit back an xml file. # if (! open(AVAIL, "$PTOPGEN -x -g -r -p GeniSlices |")) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not start avail"); } my $xml = ""; while () { $xml .= $_; } close(AVAIL); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml); } # # Update a ticket with a new rspec. # sub UpdateTicket($) { my ($argref) = @_; return GetTicket($argref, 1); } # # Respond to a GetTicket request. # sub GetTicket($;$) { my ($argref, $isupdate) = @_; my $rspec = $argref->{'rspec'}; my $impotent = $argref->{'impotent'}; my $cred = $argref->{'credential'}; my $tick = $argref->{'ticket'}; my $uuid = $argref->{'uuid'}; my $vtopo = $argref->{'virtual_topology'}; my $owner_uuid = $ENV{'GENIUSER'}; my $response = undef; my $didfwsetup = 0; my $restorevirt = 0; # Flag to restore virtual state my $restorephys = 0; # Flag to restore physical state my $ticket; # Default to no update $isupdate = 0 if (!defined($isupdate)); $impotent = 0 if (!defined($impotent)); if (! defined($cred)) { return GeniResponse->MalformedArgsResponse(); } if (defined($uuid)) { if (!($uuid =~ /^[-\w]*$/)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Improper ticket uuid: $uuid"); } $ticket = GeniTicket->Lookup($uuid); if (!defined($ticket)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such ticket here: $uuid"); } } elsif (defined($rspec)) { if (! ($rspec =~ /^[\040-\176\012\015\011]+$/)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Improper rspec"); } $rspec = XMLin($rspec, KeyAttr => [], ForceArray => ["node", "link", "interface", "interface_ref", "linkendpoints"]); } else { return GeniResponse->MalformedArgsResponse(); } if ($isupdate) { $ticket = GeniTicket->CreateFromSignedTicket($tick); if (!defined($ticket)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniTicket object"); } } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $slice_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($user_uuid ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } defined($credential) && ($credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "instantiate" ) or $credential->HasPrivilege( "bind" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" )); # # Deal with a duplicate ticket request, after verifying credential. # if (defined($uuid)) { # # Return the original ticket string, rather then creating and signing # a new version. Only the original requestor can get the ticket, which # can then be delegated if necessary. # if ($user_uuid ne $ticket->owner_uuid()) { return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Not your ticket!"); } return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString()); } # # We need this below to sign the ticket. # my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE); if (!defined($authority)) { print STDERR " Could not get uuid from $EMULAB_PEMFILE\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } # # Create slice from the certificate. # my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { if ($isupdate) { print STDERR "Could not locate slice $slice_uuid for Update\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice found for UpdateTicket"); } $slice = CreateSliceFromCertificate($credential); if (!defined($slice)) { print STDERR "Could not create $slice_uuid\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create slice"); } } # # Ditto the user. # my $user = GeniUser->Lookup($user_uuid, 1); if (!defined($user)) { if ($isupdate) { print STDERR "Could not locate $user_uuid for UpdateTicket\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No user found for UpdateTicket"); } $user = CreateUserFromCertificate($credential->owner_cert()); if (!defined($user)) { print STDERR "No user $user_uuid in the ClearingHouse\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not get user info from ClearingHouse"); } } # # A sitevar controls whether external users can get any nodes. # my $allow_externalusers = 0; if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){ # Cannot get the value, say no. $allow_externalusers = 0; } if (!$allow_externalusers && !$user->IsLocal()) { return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef, "External users temporarily denied"); } # # For now all tickets expire very quickly (minutes), but once the # ticket is redeemed, it will expire according to the rspec request. # if (exists($rspec->{'valid_until'})) { my $expires = $rspec->{'valid_until'}; if (! ($expires =~ /^[-\w:.\/]+/)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Illegal valid_until in rspec"); } # Convert to a localtime. my $when = timegm(strptime($expires)); if (!defined($when)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Could not parse valid_until"); } # # No more then 24 hours out ... Needs to be a sitevar? # my $diff = $when - time(); if ($diff < (60 * 15) || $diff > (3600 * 24)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "valid_until out of range"); } } else { # Give it a reasonable default for later when the ticket is redeemed. $rspec->{'valid_until'} = POSIX::strftime("20%y-%m-%dT%H:%M:%S", gmtime(time() + (3600*1))); } # # Lock the ticket so it cannot be released. # if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) { return GeniResponse->BusyResponse("ticket"); } # # # Lock the slice from further access. # if ($slice->Lock() != 0) { $ticket->UnLock() if (defined($ticket) && $ticket->stored()); return GeniResponse->BusyResponse("slice"); } # Shutdown slices get nothing. if ($slice->shutdown()) { $slice->UnLock(); $ticket->UnLock() if (defined($ticket) && $ticket->stored()); return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Slice has been shutdown"); } # # For now, there can be only a single toplevel aggregate per slice. # The existence of an aggregate means the slice is active here. # if (!$isupdate) { my $aggregate = GeniAggregate->SliceAggregate($slice); if (defined($aggregate)) { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Already have an aggregate for slice"); goto bad; } } # # Firewall hack; just a flag in the rspec for now. # if (exists($rspec->{'needsfirewall'}) && $rspec->{'needsfirewall'}) { if ($slice->SetFirewallFlag($rspec->{'needsfirewall'}) != 0) { $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } } # # We need this now so we can form a virtual topo. # my $slice_experiment = GeniExperiment($slice); if (!defined($slice_experiment)) { print STDERR "Could not create new Geni slice experiment!\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } my $pid = $slice_experiment->pid(); my $eid = $slice_experiment->eid(); # # Create a virt topology object. We are going to load this up as we # process the rspec. # my $virtexperiment = VirtExperiment->CreateNew($slice_experiment); if (!defined($virtexperiment)) { print STDERR "Could not create VirtExperiment object!\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } # Turn off fixnode; we will control this on the commandline. $virtexperiment->allowfixnode(0); # This is where nodes are parked until a ticket is redeemed. my $reserved_holding = Experiment->Lookup("GeniSlices", "reservations"); if (!defined($reserved_holding)) { # # This experiment has to exist! # print STDERR "Could not find Geni reservations experiment!\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } # # An rspec is a structure that requests specific nodes. If those # nodes are available, then reserve it. Otherwise the ticket # cannot be granted. # my %namemap = (); my %tofree = (); my %colomap = (); my %ifacemap = (); my %nodemap = (); my @nodeids = (); my @dealloc; # # If this is a ticket update, we want to seed the namemap with # existing nodes. This is cause the rspec might refer to wildcards # that were already bound in a previous call. We also want to know # what nodes are currently reserved in case we have to release some. # if ($isupdate) { $slice_experiment->ClearBackupState(); if ($slice_experiment->BackupVirtualState()) { print STDERR "Could not backup virtual state!\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } if ($slice_experiment->RemoveVirtualState()) { print STDERR "Could not remove virtual state!\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } $restorevirt = 1; if ($slice_experiment->BackupPhysicalState()) { print STDERR "Could not backup physical state!\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR); goto bad; } foreach my $ref (@{$ticket->rspec()->{'node'}}) { my $resource_uuid = $ref->{'component_uuid'} || $ref->{'uuid'}; my $manager_uuid = $ref->{'component_manager_uuid'}; my $manager_urn = $ref->{'component_manager_urn'}; my $node_nickname = $ref->{'virtual_id'} || $ref->{'nickname'}; my $colocate = $ref->{'colocate'} || $ref->{'phys_nickname'}; # Let remote nodes pass through. next if (defined($manager_urn) && !GeniHRN::Equal( $manager_urn, $ENV{'MYURN'} ) ); next if (defined($manager_uuid) && $manager_uuid ne $ENV{'MYUUID'}); my $node = Node->Lookup($resource_uuid); if (!defined($node)) { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Bad resource $resource_uuid in ticket"); goto bad; } # Grab the reservation. We will want to release unused nodes, # but only if not already assigned to the slice. my $reservation = $node->Reservation(); if (defined($reservation)) { $tofree{$resource_uuid} = $node if ($reservation->SameExperiment($reserved_holding)); } $namemap{$node_nickname} = $node; $colomap{$colocate} = $node if (defined($colocate)); } } print STDERR Dumper($rspec); foreach my $ref (@{$rspec->{'node'}}) { my $resource_uuid = $ref->{'component_uuid'} || $ref->{'uuid'}; my $manager_uuid = $ref->{'component_manager_uuid'}; my $manager_urn = $ref->{'component_manager_urn'}; my $node_nickname = $ref->{'virtual_id'} || $ref->{'nickname'}; my $colocate = $ref->{'colocate'} || $ref->{'phys_nickname'}; my $virtualization_type = $ref->{'virtualization_type'}; my $virtualization_subtype = $ref->{'virtualization_subtype'}; my $exclusive = $ref->{'exclusive'}; my $pctype = "pc"; my $osname = ""; my $node; # Let remote nodes pass through. next if (defined($manager_urn) && !GeniHRN::Equal( $manager_urn, $ENV{'MYURN'} ) ); next if (defined($manager_uuid) && $manager_uuid ne $ENV{'MYUUID'}); if (defined($virtualization_type)) { if ($virtualization_type eq "emulab-vnode") { $pctype = "pcvm"; if (defined($virtualization_subtype)) { if ($virtualization_subtype eq "emulab-jail") { $osname = "FBSD-JAIL"; } elsif ($virtualization_subtype eq "emulab-openvz") { $osname = "OPENVZ-STD"; } } else { goto raw; } } else { raw: # Lets force to exclusive real node. $ref->{'exclusive'} = $exclusive = 1; $ref->{'virtualization_type'} = "raw"; $pctype = "pc"; $osname = "RHL90-STD"; } } else { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "virtualization_subtype must be emulab-vnode"); goto bad; } if (!defined($node_nickname)) { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must provide a virtual_id for nodes"); goto bad; } # # Allow wildcarding. # if (!defined($resource_uuid) || $resource_uuid eq "*") { if (defined($colocate) && exists($colomap{$colocate})) { $node = $colomap{$colocate}; } elsif ($isupdate && exists($namemap{$node_nickname})) { $node = $namemap{$node_nickname}; } } else { $node = Node->Lookup($resource_uuid); if (!defined($node)) { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Bad resource $resource_uuid"); goto bad; } } my $virtnode = $virtexperiment->NewTableRow("virt_nodes", {"vname" => $node_nickname, "type" => $pctype, "osname" => $osname, "ips" => '', # deprecated "cmd_line"=> '', # bogus "fixed" => (defined($node) ? $node->node_id() : "")}); $virtexperiment->NewTableRow("virt_node_desires", {"vname" => $node_nickname, "desire" => "pcshared", "weight" => 0.95}) if (!defined($exclusive) || !$exclusive); # Store reference so we can munge it below. $nodemap{$node_nickname} = {"rspec" => $ref, "virtnode" => $virtnode}; # # Look for interface forward declarations that will be used later # in the link specifications. # next if (!exists($ref->{'interface'})); foreach my $linkref (@{$ref->{'interface'}}) { my $component_id = $linkref->{"component_id"}; my $virtual_id = $linkref->{"virtual_id"}; if (!defined($virtual_id)) { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must provide a virtual_id for interfaces"); goto bad; } $ifacemap{$node_nickname} = {} if (!exists($ifacemap{$node_nickname})); # port counter. my $vport = scalar(keys(%{ $ifacemap{$node_nickname} })); # Store reference so we can munge it below. $ifacemap{$node_nickname}->{$virtual_id} = {"rspec" => $linkref, "vport" => $vport}; # This is used after the mapper runs since it uses vname:vport. $ifacemap{"$node_nickname:$vport"} = $linkref; } } goto skiplinks if (!exists($rspec->{'link'})); # # Now deal with links for wildcarded nodes. We need to fill in the # node_uuid. # my $linknum = 1; foreach my $linkref (@{$rspec->{'link'}}) { my $nickname = $linkref->{"nickname"} || $linkref->{"virtual_id"}; my $istunnel = (exists($linkref->{'link_type'}) && $linkref->{'link_type'} eq "tunnel"); my $interfaces = $linkref->{'linkendpoints'} || $linkref->{'interface_ref'}; my $ifacenum = 1; if (!defined($nickname)) { $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must provide a virtual_id for links"); goto bad; } if (!$istunnel) { $virtexperiment->NewTableRow("virt_lan_lans", {"vname" => $nickname}); } foreach my $ref (@{ $interfaces }) { my $node_nickname = $ref->{'virtual_node_id'} || $ref->{'node_nickname'}; my $iface_id = $ref->{'virtual_interface_id'} || $ref->{'iface_name'}; if (!defined($node_nickname)) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "$nickname: Need node id for links"); goto bad; } if (!defined($iface_id)) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "$nickname: Need interface id for links"); goto bad; } if ($istunnel) { # Might be the other side. Skip for now; might bite later. next if (!exists($namemap{$node_nickname})); # Not doing anything else. next; } if (!exists($ifacemap{$node_nickname})) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "$nickname: No such virtual_node_id: ". "$node_nickname"); goto bad; } # # Sanity check the interface. # if (!exists($ifacemap{$node_nickname}->{$iface_id})) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "$nickname: No such interface on component: ". "$node_nickname:$iface_id"); goto bad; } my $iface_ref = $ifacemap{$node_nickname}->{$iface_id}->{"rspec"}; my $iface_name = $iface_ref->{"component_id"} || ""; my $iface_vport = $ifacemap{$node_nickname}->{$iface_id}->{"vport"}; # XXX my $ip = "10.10.${linknum}.${ifacenum}"; my $mask = "255.255.255.0"; my $member = "$node_nickname:$iface_vport"; $virtexperiment->NewTableRow("virt_lans", {"vname" => $nickname, "vnode" => $node_nickname, "vport" => $iface_vport, "ip" => $ip, "delay" => 0.0, "bandwidth" => 1000000, # kbps "lossrate" => 0.0, "member" => $member, "mask" => $mask, "rdelay" => 0.0, "rbandwidth" => 100000, # kbps "rlossrate" => 0.0, "fixed_iface" => $iface_name}); $ifacenum++; } $linknum++; } skiplinks: $virtexperiment->Dump(); $virtexperiment->Store(); # Must chdir to the work directory for the mapper. if (! chdir($slice_experiment->WorkDir())) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef); goto bad; } # Do a render cause its nice to have on the show experiment page. system("$PRERENDER -r $pid $eid"); system("$PRERENDER -t $pid $eid"); # # Now run the mapper in impotent mode. The idea is get a solution # without allocating any nodes. If we get a solution, and we can # allocate the nodes, we update the rspec with the physical info. # my $tmpfile = POSIX::tmpnam(); # First a prerun to get the node counts and verify topo. system("$VTOPGEN -p $pid $eid"); if ($?) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not verify topo"); goto bad; } system("$MAPPER -n -d -v -m 1 -u -o $tmpfile $pid $eid"); if ($?) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not map to resources"); unlink($tmpfile); if ($isupdate) { $slice_experiment->RemovePhysicalState(); $slice_experiment->RestorePhysicalState(); } goto bad; } my $solution = XMLin($tmpfile, KeyAttr => [], ForceArray => ["node", "link", "interface", "interface_ref", "linkendpoints"]); unlink($tmpfile); print Dumper($solution); foreach my $ref (@{$solution->{'node'}}) { my $virtual_id = $ref->{"virtual_id"}; my $component_uuid = $ref->{"component_uuid"}; my $rspec = $nodemap{$virtual_id}->{'rspec'}; my $virtnode = $nodemap{$virtual_id}->{'virtnode'}; my $node = Node->Lookup($component_uuid); my $colocate = $rspec->{'colocate'} || $rspec->{'phys_nickname'}; $rspec->{'component_uuid'} = $component_uuid; $rspec->{'component_manager_urn'} = $ENV{'MYURN'}; $rspec->{'component_manager_uuid'} = $ENV{'MYUUID'}; # Also update the virtexperiment table row. $virtnode->fixed($node->node_id()); # # Shared and remote nodes do not need to be allocated. # # XXX This is going to cause breakage since the reservations # are not recorded anyplace until the ticket is redeemed. # if (! ($node->sharing_mode() || $node->isremotenode)) { # Need to allocate this node unless already mapped. push(@nodeids, $node->node_id()) if (!exists($namemap{$virtual_id})); # Or make sure we do not free it if already allocated. delete($tofree{$component_uuid}) if ($isupdate && exists($tofree{$component_uuid})); } $namemap{$virtual_id} = $node; $colomap{$colocate} = $node if (defined($colocate)); } foreach my $ref (@{$solution->{'link'}}) { my $nickname = $ref->{"virtual_id"}; my $interfaces = $ref->{'interface_ref'}; foreach my $iface_ref (@{ $interfaces }) { my $virtual_node_id = $iface_ref->{"virtual_node_id"}; my $virtual_port_id = $iface_ref->{"virtual_port_id"}; my $component_id = $iface_ref->{"component_id"}; my $linkref = $ifacemap{"$virtual_node_id:$virtual_port_id"}; $linkref->{'component_id'} = $component_id; } } # Store the virt topo again since we changed it above. $virtexperiment->Dump(); $virtexperiment->Store(); print Dumper($rspec); # Nalloc might fail if the node gets picked up by someone else. if (@nodeids && !$impotent) { system("$NALLOC $pid reservations @nodeids"); if (($? >> 8) < 0) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Allocation failure"); goto bad; } elsif (($? >> 8) > 0) { $response = GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef, "Could not allocate some nodes"); goto bad; } # In case the code below fails, before ticket is created. @dealloc = @nodeids; } # # Create a new ticket. # my $newticket = GeniTicket->Create($authority, $user, $rspec); if (!defined($newticket)) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniTicket object"); goto bad; } if ($newticket->Sign() || $newticket->Store()) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not sign Ticket"); goto bad; } if ($isupdate) { # # Delete (not release) the old ticket. # $ticket->Delete(TICKET_RELEASED) if ($ticket->stored()); # And release any nodes we no longer wanted. if (keys(%tofree)) { my @ids = map { $_->node_id() } values(%tofree); system("export NORELOAD=1; ". "$NFREE -x -q GeniSlices reservations @ids"); } } $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $newticket->asString()); bad: system("$PRERENDER -r $pid $eid") if (defined($slice_experiment)); # # Have to be careful in a ticket update, to not release nodes that # might be referenced in the old ticket. # if ($isupdate) { if (defined($newticket)) { # Delete, not Release (which frees nodes). $newticket->Delete(TICKET_PURGED); } if (@dealloc) { system("export NORELOAD=1; ". "$NFREE -x -q GeniSlices reservations @dealloc"); } if (defined($slice_experiment) && $restorevirt) { $slice_experiment->RemoveVirtualState(); $slice_experiment->RestoreVirtualState(); } } else { # Release will free the nodes. if (defined($newticket)) { $newticket->Release(TICKET_PURGED); } elsif (@dealloc) { system("export NORELOAD=1; ". "$NFREE -x -q GeniSlices reservations @dealloc"); } # # Lets leave the experiment lying around; it will get cleaned # up when the slice is expired. But need to kill off the virtual # topo we might have added to it. # $slice_experiment->RemoveVirtualState() if (defined($slice_experiment)); } unlock: $slice->UnLock() if (defined($slice)); $ticket->UnLock() if (defined($ticket) && $ticket->stored()); return $response; } # # Redeem a ticket # sub RedeemTicket($) { my ($argref) = @_; return SliverWork($argref, 0); } # # Update a sliver # sub UpdateSliver($) { my ($argref) = @_; return SliverWork($argref, 1); } # # Utility function for above routines. # sub SliverWork($$) { my ($argref, $isupdate) = @_; my $credstr = $argref->{'credential'}; my $ticketstr = $argref->{'ticket'}; my $impotent = $argref->{'impotent'}; my $keys = $argref->{'keys'}; my $extraargs = $argref->{'extraargs'}; my $didfwsetup = 0; my $restorephys = 0; # Flag to restore physical state $impotent = 0 if (!defined($impotent)); if (! (defined($credstr) && defined($ticketstr))) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($credstr); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "instantiate" ) or $credential->HasPrivilege( "control" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); my $owner_uuid = $credential->owner_uuid(); my $owner_cert = $credential->owner_cert(); my $message = "Error creating sliver/aggregate"; my $ticket = GeniTicket->CreateFromSignedTicket($ticketstr); if (!defined($ticket)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniTicket object"); } # Only unredeemed tickets are stored in the DB. if (!$ticket->stored()) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This ticket was already redeemed!"); } # Make sure the ticket was issued to the caller. if ($ticket->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your ticket!"); } # Make sure the ticket target is this Manager if ($ticket->target_uuid() ne $ENV{'MYUUID'}) { return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "This ticket is for another authority!"); } # # For now, there can be only a single toplevel aggregate per slice. # my $aggregate; my $slice; my $slice_uuid; if ($isupdate) { $aggregate = GeniAggregate->Lookup($credential->target_uuid()); if (!defined($aggregate)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Sliver cannot be found"); } $slice_uuid = $aggregate->slice_uuid(); $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for $slice_uuid"); } } else { $slice_uuid = $credential->target_uuid(); $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for $slice_uuid"); } $aggregate = GeniAggregate->SliceAggregate($slice); if (defined($aggregate)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Already have an aggregate for slice"); } } if ($ticket->Lock() != 0) { return GeniResponse->BusyResponse("ticket"); } if ($slice->Lock() != 0) { $ticket->UnLock(); return GeniResponse->BusyResponse("slice"); } # Do not redeem an expired ticket. if ($ticket->Expired()) { $slice->UnLock(); $ticket->UnLock(); return GeniResponse->Create(GENIRESPONSE_EXPIRED, undef, "Ticket has expired"); } # Shutdown slices get nothing. if ($slice->shutdown()) { $slice->UnLock(); $ticket->UnLock(); return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Slice has been shutdown"); } # # Create the user. # my $owner = GeniUser->Lookup($owner_uuid); if (!defined($owner)) { $owner = CreateUserFromCertificate($owner_cert); if (!defined($owner)) { print STDERR "No user $owner_uuid in the ClearingHouse\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No user record for $owner_uuid"); } } if (!$owner->IsLocal() && defined($keys)) { $owner->Modify(undef, undef, $keys); } my $experiment = GeniExperiment($slice); if (!defined($experiment)) { $slice->UnLock(); $ticket->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No local experiment for slice"); } # # Figure out what nodes to allocate or free. # my %physnodes= (); my %nodemap = (); my %linkmap = (); my %toalloc = (); my %colomap = (); my @allocated= (); my @freenodes= (); my @freelinks= (); my $pid = $experiment->pid(); my $eid = $experiment->eid(); my $rspec = $ticket->rspec(); my $needplabslice = 0; # # Find current slivers and save. # if (defined($aggregate)) { my @slivers; if ($aggregate->SliverList(\@slivers) != 0) { $message = "Could not get sliverlist for $aggregate"; goto bad; } foreach my $s (@slivers) { if (ref($s) eq "GeniSliver::Node") { $nodemap{$s->nickname()} = $s; } elsif (ref($s) eq "GeniAggregate::Link" || ref($s) eq "GeniAggregate::Tunnel") { # XXX See the constructor in GeniAggregate. my ($linkname) = ($s->hrn() =~ /\.([-\w]*)$/); $linkmap{$linkname} = $s; } else { $message = "Only nodes or links allowed"; goto bad; } } } # # Figure out new expiration time; this is the time at which we can # idleswap the slice out. # if (exists($rspec->{'valid_until'})) { my $expires = $rspec->{'valid_until'}; if (! ($expires =~ /^[-\w:.\/]+/)) { $message = "Illegal valid_until in rspec"; goto bad; } # Convert to a localtime. my $when = timegm(strptime($expires)); if (!defined($when)) { $message = "Could not parse valid_until"; goto bad; } # # No more then 24 hours out ... Needs to be a sitevar? # my $diff = $when - time(); if ($diff < (60 * 15) || $diff > (3600 * 24)) { $message = "valid_until out of range"; goto bad; } if ($slice->SetExpiration($when) != 0) { $message = "Could not set expiration time"; goto bad; } } # Nodes are in this holding experiment. my $reserved_holding = Experiment->Lookup("GeniSlices", "reservations"); if (!defined($reserved_holding)) { # # This experiment has to exist! # print STDERR "Could not find Geni reservations experiment!\n"; goto bad; } # # Make sure all nodes requested are allocated. # foreach my $ref (@{$rspec->{'node'}}) { my $resource_uuid = $ref->{'component_uuid'} || $ref->{'uuid'}; my $node_nickname = $ref->{'virtual_id'} || $ref->{'nickname'}; my $manager_urn = $ref->{'component_manager_urn'}; my $manager_uuid = $ref->{'component_manager_uuid'}; # Let remote nodes pass through. next if (defined($manager_urn) && !GeniHRN::Equal( $manager_urn, $ENV{'MYURN'} ) ); next if (defined($manager_uuid) && $manager_uuid ne $ENV{'MYUUID'}); my $node = Node->Lookup($resource_uuid); if (!defined($node)) { $message = "Bad resource_uuid $resource_uuid"; goto bad; } # # Widearea nodes do not need to be allocated, but for now all # I allow is a plabdslice node. # if ($node->isremotenode()) { if (! $node->isplabphysnode()) { $message = "Only plab widearea nodes"; goto bad; } $needplabslice = 1; next; } # These are not allocated either. if ($node->sharing_mode()) { next; } # # See if the node is already reserved. # my $reservation = $node->Reservation(); if (defined($reservation)) { # Reserved during previous operation on the sliver. next if ($reservation->SameExperiment($experiment)); # Need to move it into the experiment. if ($reservation->SameExperiment($reserved_holding)) { $toalloc{$node->node_id()} = $node; next; } $message = "$resource_uuid ($node) is not available"; goto bad; } } # # What *slivers* need to be released? This may result in physical # nodes being released later. # foreach my $nickname (keys(%nodemap)) { my $sliver = $nodemap{$nickname}; my $needfree = 1; foreach my $ref (@{$rspec->{'node'}}) { my $virtual_id = $ref->{'virtual_id'} || $ref->{'nickname'}; if ($nickname eq $virtual_id) { $needfree = 0; last; } } if ($needfree) { # # Not yet. # my @dlist; if ($sliver->DependentSlivers(\@dlist) != 0) { print STDERR "Could not get DependentSlivers for $sliver\n"; goto bad; } if (@dlist) { $message = "Must tear down dependent slivers first"; goto bad; } push(@freenodes, $sliver); } } # # Create an emulab nonlocal user for tmcd. # if ($owner->BindToSlice($slice)) { $message = "Error binding user to slice"; print STDERR "$message\n"; goto bad; } # Bind the other users too. # XXX Need to figure out where these come from. my @userbindings = (); foreach my $otheruuid (@userbindings) { my $otheruser = GeniUser->Lookup($otheruuid); if (!defined($otheruser)) { $otheruser = CreateUserFromCertificate($otheruuid); if (!defined($otheruser)) { print STDERR "No user $otheruser, cannot bind to slice\n"; next; } } if ($otheruser->BindToSlice($slice) != 0) { print STDERR "Could not bind $otheruser to $slice\n"; } } # # We are actually an Aggregate, so return an aggregate of slivers, # even if there is just one node. This makes sliceupdate easier. # if (!defined($aggregate)) { # # Form the hrn from the slicename. # my $hrn = "${OURDOMAIN}." . $slice->slicename(); $aggregate = GeniAggregate->Create($slice, $owner, "Aggregate", $hrn, $slice->hrn()); if (!defined($aggregate)) { $message = "Could not create GeniAggregate object"; print STDERR "$message\n"; goto bad; } } # # We need to tear down links that are no longer in the rspec or # have changed. # foreach my $linkname (keys(%linkmap)) { my $needfree = 1; foreach my $linkref (@{$rspec->{'link'}}) { my $nickname = $linkref->{"nickname"} || $linkref->{"virtual_id"}; if ($linkname eq $nickname) { $needfree = 0; last; } } if ($needfree) { my $s = $linkmap{$linkname}; push(@freelinks, $s); delete($linkmap{$linkname}); } } if ($isupdate) { # # Backup physical state in case of failure. # if ($experiment->ClearBackupState() || $experiment->BackupPhysicalState()) { print STDERR "Could not backup physical state!\n"; goto bad; } $restorephys = 1; system("$SNMPIT -r $pid $eid"); if ($?) { print STDERR "Could not tear down vlans\n"; goto bad; } } else { # # Remove physical state. # if ($experiment->RemovePhysicalState()) { print STDERR "Could not remove physical state!\n"; goto bad; } } # Move the nodes into the experiment. if (keys(%toalloc)) { foreach my $node (values(%toalloc)) { if ($node->MoveReservation($experiment)) { print STDERR "Could not move $node to $experiment\n"; goto bad; } } } # # Now run the mapper again. All the resources are fixed, and it should # just run like it did the first time. The difference is that it will # fill out the physical tables this time. # # Must chdir to the work directory for the mapper. if (! chdir($experiment->WorkDir())) { print STDERR "Could not chdir to workdir\n"; goto bad; } # Add -u for update mode, but not -f (fixnode). system("$MAPPER -d -v -u -m 1 $pid $eid"); if ($?) { print STDERR "Mapper failed!\n"; goto bad; } # # Now for each resource (okay, node) in the ticket create a sliver and # add it to the aggregate. # my %slivers = (); my @plabnodes = (); my %ifacemap = (); my %rspecmap = (); foreach my $ref (@{$rspec->{'node'}}) { my $resource_uuid = $ref->{'component_uuid'} || $ref->{'uuid'}; my $virtual_id = $ref->{'virtual_id'} || $ref->{'nickname'}; my $manager_urn = $ref->{'component_manager_urn'}; my $manager_uuid = $ref->{'component_manager_uuid'}; $rspecmap{$virtual_id} = $ref; # Let remote nodes pass through. next if (defined($manager_urn) && !GeniHRN::Equal( $manager_urn, $ENV{'MYURN'} ) ); next if (defined($manager_uuid) && $manager_uuid ne $ENV{'MYUUID'}); # Already in the aggregate? next if (grep {$_ eq $virtual_id} keys(%nodemap)); my $node = Node->Lookup($resource_uuid); if (!defined($node)) { $message = "Unknown resource_uuid in ticket: $resource_uuid"; goto bad; } my $sliver = GeniSliver::Node->Create($slice, $owner, $resource_uuid, undef, $ref); if (!defined($sliver)) { $message = "Could not create GeniSliver object for $virtual_id"; goto bad; } $slivers{$sliver->uuid()} = $sliver; $nodemap{$virtual_id} = $sliver; # Manifest goes back to the user. $ref->{'sliver_uuid'} = $sliver->uuid(); # Add to the aggregate. if ($sliver->SetAggregate($aggregate) != 0) { $message = "Could not set aggregate for $sliver to $aggregate"; goto bad; } # See below; setup all pnodes at once. if ($node->isremotenode()) { my $vnode = Node->Lookup($sliver->uuid()); if (!defined($vnode)) { print STDERR "Could not locate vnode $sliver\n"; goto bad; } push(@plabnodes, $vnode); } # # For a map of the interfaces. # foreach my $linkref (@{$ref->{'interface'}}) { my $component_id = $linkref->{"component_id"}; my $virtual_iface_id = $linkref->{"virtual_id"}; $ifacemap{$virtual_id} = {} if (!exists($ifacemap{$virtual_id})); # Store reference so we can munge it below. $ifacemap{$virtual_id}->{$virtual_iface_id} = $component_id; } } # # Now do the links. For each link, we have to add a sliver for the # interfaces, and then combine those two interfaces into an aggregate, # and then that aggregate goes into the aggregate for toplevel sliver. # goto skiplinks if (!exists($rspec->{'link'})); foreach my $linkref (@{$rspec->{'link'}}) { my @linkslivers = (); my $linkname = $linkref->{"nickname"} || $linkref->{"virtual_id"}; my $interfaces = $linkref->{'linkendpoints'} || $linkref->{'interface_ref'}; if (! ($linkname =~ /^[-\w]*$/)) { $message = "Bad name for link: $linkname"; goto bad; } # Do not worry about modifying a link that is setup. Later. next if (grep {$_ eq $linkname} keys(%linkmap)); # # XXX Tunnels are a total kludge right now ... # if (exists($linkref->{'link_type'}) && $linkref->{'link_type'} eq "tunnel") { my $iface1ref = (@{$interfaces})[0]; my $iface2ref = (@{$interfaces})[1]; my $node1_id = $iface1ref->{'virtual_node_id'}; my $node2_id = $iface2ref->{'virtual_node_id'}; my $node1sliver = $nodemap{$node1_id}; my $node2sliver = $nodemap{$node2_id}; my $node1rspec = $rspecmap{$node1_id}; my $node2rspec = $rspecmap{$node2_id}; if (! (defined($node1sliver) || (defined($node2sliver)))) { $message = "$linkname: No local nodes for tunnel"; goto bad; } if (! (defined($node1rspec) && (defined($node2rspec)))) { $message = "$linkname: Missing nodes for tunnels"; goto bad; } my $tunnel = GeniAggregate::Tunnel->Create($slice, $owner, $node1sliver, $node2sliver, $linkref, $node1rspec, $node2rspec); if (!defined($tunnel)) { $message = "Could not create tunnel aggregate for $linkname"; goto bad; } $slivers{$tunnel->uuid()} = $tunnel; $linkmap{$linkname} = $tunnel; # Manifest goes back to the user. $linkref->{'sliver_uuid'} = $tunnel->uuid(); # Add to the aggregate. if ($tunnel->SetAggregate($aggregate) != 0) { $message = "Could not set aggregate for $tunnel to $aggregate"; goto bad; } next; } my $linkaggregate = GeniAggregate::Link->Create($slice, $owner, $linkname); if (!defined($linkaggregate)) { $message = "Could not create link aggregate for $linkname"; goto bad; } $slivers{$linkaggregate->uuid()} = $linkaggregate; $linkmap{$linkname} = $linkaggregate; # Manifest goes back to the user. $linkref->{'sliver_uuid'} = $linkaggregate->uuid(); # Add to the aggregate. if ($linkaggregate->SetAggregate($aggregate) != 0) { $message = "Could not set aggregate for $linkaggregate ". "to $aggregate"; goto bad; } foreach my $ifaceref (@{ $interfaces }) { my $iface_id = $ifaceref->{'virtual_interface_id'}; my $node_id = $ifaceref->{'virtual_node_id'}; my $nodesliver = $nodemap{$node_id}; if (!defined($nodesliver)) { $message = "Link $linkname specifies a non-existent node"; goto bad; } my $nodeobject= Node->Lookup($nodesliver->resource_uuid()); if (!defined($nodeobject)) { $message = "Could not find node object for $nodesliver"; goto bad; } # # The interface was set above. # my $iface_name = $ifacemap{$node_id}->{$iface_id}; my $interface = Interface->LookupByIface($nodeobject, $iface_name); if (!defined($interface)) { $message = "No such interface $iface_name on node $nodeobject"; goto bad; } my $sliver = GeniSliver::Interface->Create($slice, $owner, $interface->uuid(), $nodeobject, $linkname, $ifaceref); if (!defined($sliver)) { $message = "Could not create GeniSliver ". "$interface in $linkname"; goto bad; } # Manifest goes back to the user. $ifaceref->{'sliver_uuid'} = $sliver->uuid(); $ifaceref->{'MAC'} = $interface->mac(); if ($sliver->SetAggregate($linkaggregate) != 0) { $message = "Could not add link sliver $sliver to $aggregate"; goto bad; } } } skiplinks: # # Create a planetlab slice before provisioning (which creates nodes). # if ($needplabslice && !$impotent) { system("$PLABSLICE create $pid $eid"); if ($?) { $message = "Plab Slice creation failure"; goto bad; } } # Do firewall stuff. if ($slice->needsfirewall()) { my @nodeids = map { $_->node_id() } values(%toalloc); if (@nodeids && doFWlans($experiment, FWADDNODES, \@nodeids) != 0) { print STDERR "FireWall setup failed\n"; goto bad; } $didfwsetup = 1; } # # Now do the provisioning (note that we actually allocated the # node above when the ticket was granted). Then add the sliver to # the aggregate. # foreach my $sliver (values(%slivers)) { if (!$impotent && $sliver->Provision() != 0) { $message = "Could not provision $sliver"; goto bad; } } # # We want to do this stuff only once, not for each node. # # Must have the topofile for node boot. Might need locking on this. if (system("$GENTOPOFILE $pid $eid")) { print STDERR "$GENTOPOFILE failed\n"; goto bad; } # The nodes will not boot locally unless there is a DNS record. if (system("$NAMEDSETUP")) { print STDERR "$NAMEDSETUP failed\n"; goto bad; } # Set up plab nodes all at once. if ($needplabslice && @plabnodes && !$impotent) { my @node_ids = map { $_->node_id() } @plabnodes; system("$VNODESETUP -p -q -m $pid $eid @node_ids"); if ($?) { print STDERR "$VNODESETUP failed\n"; goto bad; } } # # Run snmpit ... # system("$SNMPIT -t $pid $eid"); if ($?) { $message = "Could not set up vlans"; goto bad; } # The Manifest. my $manifest = XMLout($rspec, "NoAttr" => 1); $manifest =~ s/opt\>/rspec\>/g; # # Move this elsewhere. # DBQueryWarn("replace into geni_manifests set ". " manifest=". DBQuoteSpecial($manifest) . ", " . " idx=NULL, slice_uuid='$slice_uuid', created=now()"); # # The API states we return a credential to control the aggregate. # if (!$isupdate) { $experiment->SetState(EXPTSTATE_ACTIVE()); my $sliver_credential = $aggregate->NewCredential($owner); if (!defined($sliver_credential)) { $message = "Could not create credential"; goto bad; } $ticket->Redeem(); $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS, [$sliver_credential->asString(), $manifest]); } # # Free any slivers that were no longer wanted. # foreach my $s (@freelinks) { $s->UnProvision(); $s->Delete(0); } foreach my $s (@freenodes) { $s->UnProvision(); $s->Delete(0); } $ticket->Redeem(); $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $manifest); bad: foreach my $sliver (values(%slivers)) { $sliver->UnProvision(1) if (! $impotent); $sliver->Delete(GENI_PURGEFLAG); } # Move the nodes back into the holding experiment. if (keys(%toalloc)) { my @nodeids = map { $_->node_id() } values(%toalloc); if ($slice->needsfirewall() && $didfwsetup) { if (@nodeids && doFWlans($experiment, FWDELNODES, \@nodeids)) { print STDERR "FireWall cleanup failed\n"; } } foreach my $node (values(%toalloc)) { if ($node->MoveReservation($reserved_holding)) { print STDERR "Could not move $node to $reserved_holding\n"; } } } if ($isupdate) { # # Restore old physical state. # if ($restorephys) { $experiment->RemovePhysicalState(); $experiment->RestorePhysicalState(); } system("$SNMPIT -t $pid $eid"); if ($?) { print STDERR "Could not restore vlans\n"; } } else { system("$SNMPIT -r $pid $eid"); if ($?) { print STDERR "Could not tear down vlans\n"; } } $aggregate->Delete(GENI_PURGEFLAG) if (defined($aggregate) && !$isupdate); $slice->UnLock(); $ticket->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, $message); } # # Release a ticket. # sub ReleaseTicket($) { my ($argref) = @_; my $ticket = $argref->{'ticket'}; if (! (defined($ticket) && !TBcheck_dbslot($ticket, "default", "text", TBDB_CHECKDBSLOT_ERROR))) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "ticket: ". TBFieldErrorString()); } $ticket = GeniTicket->CreateFromSignedTicket($ticket); if (!defined($ticket)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniTicket object"); } # # Make sure the credential was issued to the caller. # if ($ticket->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } # # If the ticket is not stored, it is not a ticket that needs # to be released. It is a copy or a reissue. Needs more thought. # if (! $ticket->stored()) { return GeniResponse->Create(GENIRESPONSE_SUCCESS); } if ($ticket->Lock() != 0) { return GeniResponse->BusyResponse("ticket"); } if ($ticket->Release(TICKET_RELEASED) != 0) { print STDERR "Error releasing $ticket\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } return GeniResponse->Create(GENIRESPONSE_SUCCESS); } # # Start a sliver (not sure what this means yet, so reboot for now). # sub StartSliver($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $impotent = $argref->{'impotent'}; $impotent = 0 if (!defined($impotent)); if (!defined($cred)) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $sliver_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "control" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); my $sliver = GeniSliver->Lookup($sliver_uuid); if (!defined($sliver)) { # Might be an aggregate instead. $sliver = GeniAggregate->Lookup($sliver_uuid); if (!defined($sliver)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such sliver/aggregate $sliver_uuid"); } } # # Lock the slice to avoid concurrent operation. # my $slice = GeniSlice->Lookup($sliver->slice_uuid()); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for slice"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } # Shutdown slices get nothing. if ($slice->shutdown()) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "Slice has been shutdown"); } if (!$impotent && $sliver->Start() != 0) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not start sliver/aggregate"); } $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS); } # # Destroy a sliver/aggregate. # sub DeleteSliver($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $impotent = $argref->{'impotent'}; my $response; $impotent = 0 if (!defined($impotent)); if (!defined($cred)) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $sliver_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "instantiate" ) or $credential->HasPrivilege( "control" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); # # For now, only allow top level aggregate to be deleted. # my $aggregate = GeniAggregate->Lookup($sliver_uuid); if (!defined($aggregate)) { my $sliver = GeniSliver->Lookup($sliver_uuid); if (defined($sliver)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must supply toplevel sliver"); } else { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such sliver"); } } elsif ($aggregate->type() ne "Aggregate") { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must supply toplevel sliver"); } my $slice_uuid = $aggregate->slice_uuid(); my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for slice"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } my $experiment = $slice->GetExperiment(); my $pid = $experiment->pid(); my $eid = $experiment->eid(); if (!$impotent) { system("$SNMPIT -r $pid $eid"); if ($?) { print STDERR "Could not tear down vlans\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not tear down vlans"); goto bad; } # # A firewalled slice gets special treatment. # if ($slice->needsfirewall()) { if (undoFWNodes($experiment, 1) != 0) { print STDERR "FireWall cleanup failed\n"; $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not tear down firewall"); goto bad; } } if ($aggregate->UnProvision() != 0) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not unprovision sliver"); goto bad; } if ($aggregate->Delete(0) != 0) { $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not delete sliver"); goto bad; } DBQueryWarn("delete from geni_manifests ". "where slice_uuid='$slice_uuid'"); $experiment->RemoveVirtualState(); $experiment->RemovePhysicalState(); } $experiment->SetState(EXPTSTATE_SWAPPED()); $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS); bad: return $response; } # # Remove a record, specifically a slice on this component. # sub DeleteSlice($) { my ($argref) = @_; my $credential = $argref->{'credential'}; if (! defined($credential)) { return GeniResponse->MalformedArgsResponse(); } $credential = GeniCredential->CreateFromSigned($credential); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $slice_uuid = $credential->target_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "instantiate" ) or $credential->HasPrivilege( "control" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); # # See if we have a record of this slice in the DB. If not, then we have # to go to the ClearingHouse to find its record, so that we can find out # who the SA for it is. # my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such slice on this component: $slice_uuid"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } if (CleanupDeadSlice($slice) != 0) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not cleanup slice"); } return GeniResponse->Create(GENIRESPONSE_SUCCESS); } # # Split an aggregated sliver into its separate parts and return a list. # sub SplitSliver($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $impotent = $argref->{'impotent'}; $impotent = 0 if (!defined($impotent)); if (!defined($cred)) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $sliver_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "instantiate" ) or $credential->HasPrivilege( "control" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); my $user = GeniUser->Lookup($user_uuid); if (!defined($user)) { $user = CreateUserFromCertificate($credential->owner_cert()); if (!defined($user)) { print STDERR "No user $user_uuid in the ClearingHouse\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No user record for $user_uuid"); } } my $aggregate = GeniAggregate->Lookup($sliver_uuid); if (!defined($aggregate)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such aggregate $sliver_uuid"); } my $slice = GeniSlice->Lookup($aggregate->slice_uuid()); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such slice on this component"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } my @sliver_list = (); if ($aggregate->SliverList(\@sliver_list) != 0) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not get slivers for $aggregate"); } my @credentials = (); foreach my $sliver (@sliver_list) { my $credential = $sliver->NewCredential($user); if (!defined($credential)) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create credential for $sliver"); } push(@credentials, $credential->asString()); } $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@credentials); } # # Return the top level aggregate (sliver) for a slice. # sub GetSliver($) { my ($argref) = @_; my $cred = $argref->{'credential'}; if (!defined($cred)) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $slice_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "info" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); my $user = GeniUser->Lookup($user_uuid); if (!defined($user)) { $user = CreateUserFromCertificate($credential->owner_cert()); if (!defined($user)) { print STDERR "Could not create user from certificate\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } } my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for slice"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } my $aggregate = GeniAggregate->SliceAggregate($slice); if (!defined($aggregate)) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef, "No slivers here for slice"); } my $new_credential = $aggregate->NewCredential($user); if (!defined($new_credential)) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR); } $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $new_credential->asString()); } # # Bind additional user to a slice, including keys. This is allowed because # the user has a slice credential, which came from the SA for the slice. # Note that this call can also be used to update your keys. # sub BindToSlice($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $keys = $argref->{'keys'}; if (!defined($cred)) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $slice_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "bind" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef, "Slice does not exist here"); } # # Find or create the user. # my $user = GeniUser->Lookup($user_uuid); if (!defined($user)) { $user = CreateUserFromCertificate($credential->owner_cert()); if (!defined($user)) { print STDERR "Could not create user from certificate\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create/find user"); } } if (!$user->IsLocal() && defined($keys)) { $user->Modify(undef, undef, $keys); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } # Bind for future slivers. if ($slice->BindUser($user) != 0) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Error binding slice to user"); } # Bind for existing slivers. if ($user->BindToSlice($slice) != 0) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Error binding user to slice"); } $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS); } # # Shutdown a slice. This is brutal at present; kill it completely. # sub Shutdown($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $clear = $argref->{'clear'}; if (! (defined($cred))) { return GeniResponse->MalformedArgsResponse(); } $clear = (defined($clear) ? $clear : 0); my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $slice_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "instantiate" ) or $credential->HasPrivilege( "control" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); # # Create the slice record, since we do not want a request to come # in later. # my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { $slice = CreateSliceFromCertificate($credential); if (!defined($slice)) { print STDERR "Could not create $slice_uuid\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create slice"); } # No point in doing anything else ... $slice->SetShutdown(1); return GeniResponse->Create(GENIRESPONSE_SUCCESS); } # # Do not worry about locking when setting the shutdown time. # This can lead to race though, if a clear shutdown comes in first. # Seems unlikely though. # if (!$clear) { # Do not overwrite original shutdown time $slice->SetShutdown(1) if (!defined($slice->shutdown()) || $slice->shutdown() eq ""); } else { $slice->SetShutdown(0); } # Always make sure the slice is shutdown. if ($slice->shutdown()) { # The expire daemon is going to look for this, so it will get # taken care of shortly. if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } if (CleanupDeadSlice($slice, 0) != 0) { SENDMAIL($TBOPS, "Failed to shutdown slice", "Failed to shutdown slice $slice\n"); print STDERR "Could not shutdown $slice!\n"; # Lets call this a non-error since the local admin person # is going to have to deal with it anyway. } $slice->UnLock(); } return GeniResponse->Create(GENIRESPONSE_SUCCESS); } # # Return a list of resources currently in use. # This is used by the clearinghouse to get a global sense of usage. # Currently, only the ClearingHouse will be allowed to make this call, # but eventually I think it should be opened up to any of federation # roots # sub ListUsage($) { my ($argref) = @_; my $cred = $argref->{'credential'}; if (! (defined($cred))) { return GeniResponse->MalformedArgsResponse(); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } # # And that the target of the credential is this registry. # if ($credential->target_uuid() ne $ENV{'MYUUID'}) { return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "This is not your authority!"); } # Just one of these, at Utah. my $GENICH_PEMFILE = "@prefix@/etc/genich.pem"; my $certificate = GeniCertificate->LoadFromFile($GENICH_PEMFILE); if (!defined($certificate)) { print STDERR "Could not load certificate from $GENICH_PEMFILE\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } # The caller has to match the clearinghouse. if ($credential->owner_uuid() ne $certificate->uuid()) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Only the clearinghouse can do this!"); } my @slices; if (GeniSlice->ListAll(\@slices) != 0) { return GeniResponse->Create(GENIRESPONSE_ERROR); } my @result = (); foreach my $slice (@slices) { # # Grab all the slivers for this slice, and then # look for just the nodes. # my @slivers = (); my @components = (); if (GeniSliver->SliceSlivers($slice, \@slivers) != 0) { print STDERR "Could not slice slivers for $slice\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } foreach my $sliver (@slivers) { next if ($sliver->resource_type() ne "Node"); my $node = {"sliver_gid" => $sliver->cert(), "sliver_hrn" => $sliver->hrn() }; my $component = GeniComponent->Lookup($sliver->resource_uuid()); if (defined($component)) { $node->{"component_gid"} = $component->cert(); $node->{"component_hrn"} = $component->hrn(); } else { print STDERR "No component in DB for resource ". $sliver->resource_uuid() . "\n"; } push(@components, $node); } next if (!@components); my $blob = {"slice_gid" => $slice->cert(), "slice_hrn" => $slice->hrn(), "slivers" => \@components }; push(@result, $blob); } return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@result); } # # Return historical data. This is used by the clearinghouse to get stats. # Currently, only the ClearingHouse will be allowed to make this call. # sub ListHistory($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $type = $argref->{'type'}; if (! (defined($cred))) { return GeniResponse->MalformedArgsResponse(); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } # # And that the target of the credential is this registry. # if ($credential->target_uuid() ne $ENV{'MYUUID'}) { return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef, "This is not your authority!"); } # Just one of these, at Utah. my $GENICH_PEMFILE = "@prefix@/etc/genich.pem"; my $certificate = GeniCertificate->LoadFromFile($GENICH_PEMFILE); if (!defined($certificate)) { print STDERR "Could not load certificate from $GENICH_PEMFILE\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } # The caller has to match the clearinghouse. if ($credential->owner_uuid() ne $certificate->uuid()) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Only the clearinghouse can do this!"); } my @tickets; if (GeniUsage->ListTickets(\@tickets) != 0) { return GeniResponse->Create(GENIRESPONSE_ERROR); } my @result = (); foreach my $ticket (@tickets) { my $blob = {"owner_hrn" => $ticket->{'owner_hrn'}, "slice_hrn" => $ticket->{'slice_hrn'}, "created" => $ticket->{'created'}, "redeemed" => $ticket->{'redeemed'}, "expired" => $ticket->{'expired'}, "released" => $ticket->{'released'}, "rspec" => $ticket->{'rspec_string'}}; push(@result, $blob); } return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@result); } # # Slice Status # sub SliceStatus($) { my ($argref) = @_; my $cred = $argref->{'credential'}; my $mode = $argref->{'mode'}; $mode = "summary" if (!defined($mode)); if (! (defined($cred))) { return GeniResponse->MalformedArgsResponse(); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $slice_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "info" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef, "No such slice here"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } my $aggregate = GeniAggregate->SliceAggregate($slice); if (!defined($aggregate)) { $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef, "No slivers here for slice"); } # # Grab all the slivers for this slice, and then # look for just the nodes. # my $summary = "ready"; my %details = (); my @slivers = (); if (GeniSliver->SliceSlivers($slice, \@slivers) != 0) { print STDERR "Could not get slivers for $slice\n"; $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR); } foreach my $sliver (@slivers) { next if ($sliver->resource_type() ne "Node"); my $node_uuid = $sliver->uuid(); my $node = Node->Lookup($node_uuid); if (!defined($node)) { $slice->UnLock(); print STDERR "Cannot find node by uuid $node_uuid\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } if ($node->IsUp()) { $details{$node_uuid} = "ready"; } else { $details{$node_uuid} = "notready"; $summary = "notready"; } } $slice->UnLock(); my $blob = {"status" => $summary, "details" => \%details}; return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob); } # # Get the ticket/manifest for a sliver. # sub SliverTicket($) { my ($argref) = @_; my $cred = $argref->{'credential'}; if (! (defined($cred))) { return GeniResponse->MalformedArgsResponse(); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $sliver_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "info" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); # # We need this below to sign the ticket. # my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE); if (!defined($authority)) { print STDERR "Could not load certificate from $EMULAB_PEMFILE\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } my $user = GeniUser->Lookup($user_uuid, 1); if (!defined($user)) { print STDERR "Could not locate user $user_uuid\n"; return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No user found"); } my $aggregate = GeniAggregate->Lookup($sliver_uuid); if (!defined($aggregate)) { return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED, undef, "No such sliver here"); } if ($aggregate->type() ne "Aggregate") { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must supply toplevel sliver"); } my $slice_uuid = $aggregate->slice_uuid(); my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for slice"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } my $query_result = DBQueryWarn("select manifest from geni_manifests ". "where slice_uuid='$slice_uuid'"); if (!$query_result || !$query_result->numrows) { print STDERR "Could not locate manifest for $slice/$aggregate\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } my $row = $query_result->fetchrow_hashref(); my $rspec = $row->{'manifest'}; # # Create a new ticket. # my $ticket = GeniTicket->Create($authority, $user, $rspec); if (!defined($ticket)) { print STDERR "Could not create new ticket for $slice/$aggregate\n"; $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create Ticket"); } if ($ticket->Sign()) { print STDERR "Could not sign new ticket $ticket\n"; # Delete, not Release (which frees nodes). $ticket->Delete(TICKET_PURGED); $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not sign Ticket"); } $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_SUCCESS, $ticket->asString()); } # # Sliver status. # sub SliverStatus($) { my ($argref) = @_; my $cred = $argref->{'credential'}; if (!defined($cred)) { return GeniResponse->Create(GENIRESPONSE_BADARGS); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } my $sliver_uuid = $credential->target_uuid(); my $user_uuid = $credential->owner_uuid(); # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } $credential->HasPrivilege( "pi" ) or $credential->HasPrivilege( "info" ) or return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef, "Insufficient privilege" ); # # For now, only allow top level aggregate to be deleted. # my $aggregate = GeniAggregate->Lookup($sliver_uuid); if (!defined($aggregate)) { my $sliver = GeniSliver->Lookup($sliver_uuid); if (defined($sliver)) { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must supply toplevel sliver"); } else { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "No such sliver"); } } elsif ($aggregate->type() ne "Aggregate") { return GeniResponse->Create(GENIRESPONSE_BADARGS, undef, "Must supply toplevel sliver"); } my $slice_uuid = $aggregate->slice_uuid(); my $slice = GeniSlice->Lookup($slice_uuid); if (!defined($slice)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No slice record for slice"); } if ($slice->Lock() != 0) { return GeniResponse->BusyResponse(); } # # Grab all the slivers for this slice, and then # look for just the nodes. # my $summary = "ready"; my %details = (); my @slivers = (); if ($aggregate->SliverList(\@slivers) != 0) { print STDERR "Could not get slivers for $aggregate\n"; $slice->UnLock(); return GeniResponse->Create(GENIRESPONSE_ERROR); } foreach my $sliver (@slivers) { next if ($sliver->isa("GeniAggregate")); next if ($sliver->resource_type() ne "Node"); my $node_uuid = $sliver->uuid(); my $node = Node->Lookup($node_uuid); if (!defined($node)) { $slice->UnLock(); print STDERR "Cannot find node by uuid $node_uuid\n"; return GeniResponse->Create(GENIRESPONSE_ERROR); } if ($node->IsUp()) { $details{$node_uuid} = "ready"; } else { $details{$node_uuid} = "notready"; $summary = "notready"; } } $slice->UnLock(); my $blob = {"status" => $summary, "details" => \%details}; return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob); } # # Return a list of unredeemed tickets. # sub ListTickets($) { my ($argref) = @_; my $cred = $argref->{'credential'}; if (! (defined($cred))) { return GeniResponse->MalformedArgsResponse(); } my $credential = GeniCredential->CreateFromSigned($cred); if (!defined($credential)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "Could not create GeniCredential object"); } # # Make sure the credential was issued to the caller. # if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "This is not your credential!"); } my $user_uuid = $credential->owner_uuid(); my $user = GeniUser->Lookup($user_uuid, 1); if (!defined($user)) { return GeniResponse->Create(GENIRESPONSE_ERROR, undef, "No such user found"); } # # A plain credential issued to a user lets that user get a list # of his own tickets. At some point allow the clearinghouse to # get more data. # my @tickets; if (GeniTicket->ListUserTickets($user, \@tickets) != 0) { return GeniResponse->Create(GENIRESPONSE_ERROR); } my @result = (); foreach my $ticket (@tickets) { # Convert to GMT. my $expires = POSIX::strftime("20%y-%m-%dT%H:%M:%S", gmtime(str2time($ticket->redeem_before()))); my $blob = {"uuid" => $ticket->ticket_uuid(), "expires" => $expires, "redeem_before" => $expires, }; push(@result, $blob); } return GeniResponse->Create(GENIRESPONSE_SUCCESS, \@result); } # # Utility Routines. # # Create a slice from the a certificate (GID). # sub CreateSliceFromCertificate($) { my ($credential) = @_; my $certificate = $credential->target_cert(); my $owner_uuid = $credential->owner_uuid(); my $authority = GeniAuthority->LookupByPrefix($certificate->uuid()); if (!defined($authority)) { $authority = CreateAuthorityFromRegistry($certificate->uuid()); if (!defined($authority)) { print STDERR "Could not create new authority record\n"; return undef; } } # # The problem with HRNs is that people will tend to reuse them. # So check to see if we have a slice with the hrn, and if so # we need to check with the registry to see if its still active. # Destroy it locally if not active. # my $slice = GeniSlice->Lookup($certificate->hrn()); if (defined($slice)) { return $slice if ($slice->uuid() eq $certificate->uuid()); if ($slice->Lock() != 0) { print STDERR "Could not lock $slice\n"; return undef; } if (CleanupDeadSlice($slice) != 0) { print STDERR "Could not cleanup dead slice $slice\n"; $slice->UnLock(); return undef; } } $slice = GeniSlice->Create($certificate, $owner_uuid, $authority); return undef if (!defined($slice)); return $slice; } # # Create a user from a certificate. # sub CreateUserFromCertificate($) { my ($certificate) = @_; # # Check Emulab users table first. # my $user = User->LookupByUUID($certificate->uuid()); if (defined($user)) { my $geniuser = GeniUser->CreateFromLocal($user); if (!defined($geniuser)) { print STDERR "Could not create geniuser from $user\n"; return undef; } return $geniuser; } my $authority = GeniAuthority->LookupByPrefix($certificate->uuid()); if (!defined($authority)) { $authority = CreateAuthorityFromRegistry($certificate->uuid()); if (!defined($authority)) { print STDERR "Could not create new authority record\n"; return undef; } } return GeniUser->Create($certificate, $authority); } # # Create authority from the ClearingHouse, by looking up the info. # sub CreateAuthorityFromRegistry($) { my ($uuid) = @_; my ($prefix) = ($uuid =~ /^\w+\-\w+\-\w+\-\w+\-(\w+)$/); my $clearinghouse = GeniRegistry::ClearingHouse->Create(); return undef if (!defined($clearinghouse)); my $blob; return undef if ($clearinghouse->Resolve("P${prefix}", "SA", \$blob) != 0); my $certificate = GeniCertificate->LoadFromString($blob->{'gid'}); return undef if (!defined($certificate)); my $authority = GeniAuthority->Create($certificate, $blob->{'url'}, $blob->{'type'}); $certificate->Delete() if (!defined($authority)); return $authority; } # # Cleanup a dead slice, releasing all the stuff associated with it. # sub CleanupDeadSlice($;$) { my ($slice, $purge) = @_; # Default to full purge. $purge = 1 if (!defined($purge)); # print "Cleaning up dead slice $slice\n"; my $slice_uuid = $slice->uuid(); my $experiment = $slice->GetExperiment(); if (defined($experiment)) { my $pid = $experiment->pid(); my $eid = $experiment->eid(); system("$SNMPIT -r $pid $eid"); if ($?) { print STDERR "Could not tear down vlans\n"; return -1; } # # A firewalled slice gets special treatment. # if ($slice->needsfirewall()) { print "Calling undoFWNodes ...\n"; if (undoFWNodes($experiment, 1) != 0) { print STDERR "FireWall cleanup failed\n"; return -1; } } } # # Find any aggregates and tear them down. # my @aggregates; if (GeniAggregate->SliceAggregates($slice, \@aggregates) != 0) { print STDERR "Could not get dead aggregates for $slice.\n"; return -1; } # # Link aggregates first. # my @nonlinks = (); foreach my $aggregate (@aggregates) { if (! ($aggregate->type() eq "Link" || $aggregate->type() eq "Tunnel")) { push(@nonlinks, $aggregate); next; } if ($aggregate->UnProvision() != 0) { print STDERR "Could not UnProvision $aggregate\n"; return -1; } if ($aggregate->Delete(0) != 0) { print STDERR "Could not delete $aggregate\n"; return -1; } } foreach my $aggregate (@nonlinks) { if ($aggregate->UnProvision() != 0) { print STDERR "Could not UnProvision $aggregate\n"; return -1; } if ($aggregate->Delete(0) != 0) { print STDERR "Could not delete $aggregate\n"; return -1; } } # # Are there any slivers left after killing the aggregates? # my @slivers; if (GeniSliver->SliceSlivers($slice, \@slivers) != 0) { print STDERR "Could not get dead slivers for $slice.\n"; return -1; } foreach my $sliver (@slivers) { if ($sliver->UnProvision() != 0) { print STDERR "Could not UnProvision $sliver\n"; return -1; } if ($sliver->Delete(0) != 0) { print STDERR "Could not delete $sliver\n"; return -1; } } DBQueryWarn("delete from geni_manifests ". "where slice_uuid='$slice_uuid'"); return 0 if (!$purge); if (defined($experiment)) { my @pnodes = $experiment->NodeList(1, 1); my $pnodes = scalar(@pnodes); # Ignore the firewall node in this test; released in endexp. $pnodes-- if ($slice->needsfirewall()); if ($pnodes != 0) { print STDERR "There were still nodes allocated to $experiment!\n"; } $experiment->LockDown(0); my $pid = $experiment->pid(); my $eid = $experiment->eid(); system("$PLABSLICE destroy $pid $eid"); system("$ENDEXPT -q $pid,$eid"); return -1 if ($?); $experiment->Flush(); } if ($slice->Delete() != 0) { print STDERR "Could not delete $slice\n"; return -1; } return 0; } # # If the underlying experiment does not exist, need to create # a holding experiment. All these are going to go into the same # project for now. Generally, users for non-local slices do not # have local accounts or directories. # sub GeniExperiment($) { my ($slice) = @_; my $uuid = $slice->uuid(); my $needsfirewall = $slice->needsfirewall(); my $experiment = Experiment->Lookup($uuid); if (!defined($experiment)) { # # Form an eid for the experiment. # my $eid = "slice" . TBGetUniqueIndex('next_sliceid', 1); my $nsfile = ""; # # Need a way to can experiments. # if ($needsfirewall) { $nsfile = "/tmp/$$.ns"; open(NS, "> $nsfile") or return undef; print NS "source tb_compat.tcl\n"; print NS "set ns [new Simulator]\n"; print NS "tb-set-security-level Blue\n"; print NS "\$ns run\n"; close(NS); } # Note the -h option; allows experiment with no NS file. system("$CREATEEXPT -q -i -k -w ". "-S 'Geni Slice Experiment -- DO NOT SWAP OR TERMINATE' ". "-E 'Geni Slice Experiment -- DO NOT SWAP OR TERMINATE' ". "-L 'Geni Slice Experiment -- DO NOT SWAP OR TERMINATE' ". "-h '$uuid' -p GeniSlices -e $eid $nsfile"); if ($?) { return undef; } $experiment = Experiment->Lookup($uuid); $experiment->SetState(EXPTSTATE_SWAPPED()); $experiment->Update({"geniflags" => 1}); } return $experiment; } # _Always_ make sure that this 1 is at the end of the file... 1;