GeniCM.pm.in 119 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -wT
#
3
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2008-2010 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 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;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24 25
use GeniResponse;
use GeniTicket;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use GeniCredential;
27
use GeniCertificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
28
use GeniSlice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
use GeniAggregate;
30
use GeniAuthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31
use GeniSliver;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
32
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
33
use GeniRegistry;
34
use GeniUtil;
35
use GeniHRN;
36
use GeniXML;
37
use GeniUsage;
38
use libtestbed qw(SENDMAIL);
39
use emutil;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
40
# Hate to import all this crap; need a utility library.
41 42
use libdb qw(TBGetSiteVar EXPTSTATE_SWAPPED EXPTSTATE_ACTIVE TBOPSPID
	     TBDB_NODESTATE_TBFAILED);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
use User;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
44
use Node;
45
use Lan;
46
use OSinfo;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47
use Image;
48
use Interface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
49 50
use English;
use Data::Dumper;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
51
use XML::Simple;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
52
use Date::Parse;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
53
use POSIX qw(strftime tmpnam);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
54
use Time::Local;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
55
use Experiment;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56
use VirtExperiment;
57
use Firewall;
58
use Compress::Zlib;
59
use File::Temp qw(tempfile);
60
use MIME::Base64;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61 62 63 64 65 66 67 68

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
69
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
70
my $CREATEEXPT     = "$TB/bin/batchexp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
71
my $ENDEXPT        = "$TB/bin/endexp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
my $NALLOC	   = "$TB/bin/nalloc";
73
my $NFREE	   = "$TB/bin/nfree";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
74
my $AVAIL	   = "$TB/sbin/avail";
75
my $PTOPGEN	   = "$TB/libexec/ptopgen";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
76 77
my $TBSWAP	   = "$TB/bin/tbswap";
my $SWAPEXP	   = "$TB/bin/swapexp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
78 79
my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
my $NAMEDSETUP     = "$TB/sbin/named_setup";
80
my $EXPORTS_SETUP  = "$TB/sbin/exports_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
81 82
my $VNODESETUP     = "$TB/sbin/vnode_setup";
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
83
my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
84 85 86 87
my $MAPPER         = "$TB/bin/mapper";
my $VTOPGEN        = "$TB/bin/vtopgen";
my $SNMPIT         = "$TB/bin/snmpit";
my $PRERENDER      = "$TB/libexec/vis/prerender";
88
my $XMLLINT	   = "/usr/local/bin/xmllint";
89
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
90

91 92 93 94 95 96 97 98 99 100 101 102
my $API_VERSION = 1;

#
# Tell the client what API revision we support.  The correspondence
# between revision numbers and API features is to be specified elsewhere.
# No credentials are required.
#
sub GetVersion()
{
    return GeniResponse->Create( GENIRESPONSE_SUCCESS, $API_VERSION );
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
103
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
104
# Respond to a Resolve request. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
105 106 107 108 109 110
#
sub Resolve($)
{
    my ($argref) = @_;
    my $uuid       = $argref->{'uuid'};
    my $cred       = $argref->{'credential'};
111 112
    my $type       = lc( $argref->{'type'} );
    my $hrn        = $argref->{'hrn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113 114 115 116

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
117 118 119 120
    if (defined($uuid) && GeniHRN::IsValid($uuid)) {
	$hrn  = $uuid;
	$uuid = undef;
    }
121 122 123 124 125 126 127 128 129 130 131 132
    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)$/))) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
133 134 135
	return GeniResponse->MalformedArgsResponse();
    }
    # Allow lookup by uuid or hrn.
136
    if (! defined($uuid) && !defined( $hrn ) ) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
	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!");
    }
157
    if ($type eq "node") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
158 159 160
	my $node;
	
	if (defined($uuid)) {
161
	    $node= GeniUtil::LookupNode($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
162 163
	}
	else {
164
	    $node= GeniUtil::LookupNode($hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
165
	}
166
	if (! defined($node)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
167 168 169
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					undef, "Nothing here by that name");
	}
170 171 172 173 174 175

	my $rspec = GetAdvertisement(0, $node->node_id());
	if (! defined($rspec)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not start avail");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
176 177
	
	# Return a blob.
178
	my $blob = { "hrn"          => "${PGENIDOMAIN}." . $node->node_id(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
179
		     "uuid"         => $node->uuid(),
180
		     "role"	    => $node->role(),
181 182
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
183 184
		     "physctrl"     => 
			 Interface->LookupControl( $node->phys_nodeid() )->IP(),
185 186
		     "urn"          => GeniHRN::Generate( $OURDOMAIN,
							  "node",
187 188
							  $node->node_id() ),
		     "rspec"        => $rspec
Leigh B. Stoller's avatar
Leigh B. Stoller committed
189 190 191 192 193 194 195
		   };

	return GeniResponse->Create(GENIRESPONSE_SUCCESS, $blob);
    }
    return GeniResponse->Create(GENIRESPONSE_UNSUPPORTED);
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
196 197 198 199 200 201 202
#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
    my $credential = $argref->{'credential'};
203 204
    my $available = $argref->{'available'} || 0;
    my $compress = $argref->{'compress'} || 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
205 206 207 208 209 210 211 212
    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.
213
    if ($user_uuid ne $credential->owner_uuid()) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
214 215 216
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Invalid credentials for operation");
    }
217
    return DiscoverResourcesAux($available, $compress, [$credential]);
218 219
}
# Helper function for V2.
220
sub DiscoverResourcesAux($$$)
221
{
222
    my ($available, $compress, $credentials) = @_;
223
    my $user_uuid  = $ENV{'GENIUSER'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
224

225 226 227
    # Oh, for $*%(s sake.  Frontier::RPC2 insists on representing a
    # Boolean as its own object type -- which Perl always interprets as
    # true, regardless of the object's value.  Undo all of that silliness.
228 229 230 231 232 233
    if (defined($available) && ref($available) eq 'Frontier::RPC2::Boolean') {
	$available = $available->value;
    }
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
234

Leigh B. Stoller's avatar
Leigh B. Stoller committed
235 236 237 238 239
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
    if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
240 241
	      # Cannot get the value, say no.
	      $allow_externalusers = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
242
    }
243 244 245 246 247 248 249

    # Figure out if user has a credentials that exempts him
    # from the following policy. If external users are blocked access
    # and he presents a credential that exempts him from it, 
    # then he should get access.
    my $isExempted = 0;
    foreach my $credential (@$credentials) {
250
        if (GeniXML::PolicyExists('allow_externalusers', $credential) == 1) {
251 252 253 254 255 256
        $isExempted = 1;
        last;
      }
    }

    if (!$allow_externalusers && !$isExempted) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
257 258 259 260 261 262 263 264
	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");
	}
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
265
    #
266
    # Acquire the advertisement from ptopgen and compress it if requested.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
267
    #
268 269
    my $xml = GetAdvertisement($available, undef);
    if (! defined($xml)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
270 271 272 273
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start avail");
    }

274 275 276 277 278 279
    if( $compress ) {
	my $coder = Frontier::RPC2->new();
	my $base64 = encode_base64( compress( $xml ) );
	$xml = $coder->base64( $base64 );	
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
280 281
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
282

283 284 285 286 287 288 289 290
#
# Use ptopgen in xml mode to spit back an xml file. 
#
sub GetAdvertisement($$)
{
    my ($available, $pc) = @_;
    my $xml = undef;

291
    my $invocation = "$PTOPGEN -x -g 0.1 -r -p GeniSlices";
292 293 294 295 296
    $invocation .= " -a" unless $available;
    if (defined($pc)) {
	$invocation .= " -1 $pc";
    }
    if (open(AVAIL, "$invocation |")) {
297
	$xml = "";
298 299 300 301 302 303 304 305
	while (<AVAIL>) {
	    $xml .= $_;
	}
	close(AVAIL);
    }
    return $xml;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
306
#
307
# Update a ticket with a new rspec.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
308
#
309
sub UpdateTicket($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
310 311
{
    my ($argref) = @_;
312 313 314 315 316 317 318 319 320 321

    return GetTicket($argref, 1);
}

#
# Respond to a GetTicket request. 
#
sub GetTicket($;$)
{
    my ($argref, $isupdate) = @_;
322
    my $rspecstr   = $argref->{'rspec'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
323
    my $impotent   = $argref->{'impotent'};
324 325
    my $credstr    = $argref->{'credential'};
    my $tickstr    = $argref->{'ticket'};
326 327 328 329 330 331 332
    my $ticket;

    # Default to no update
    $isupdate = 0
	if (!defined($isupdate));
    $impotent = 0
	if (!defined($impotent));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
333

334
    if (! defined($credstr)) {
335
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
336
    }
337
    if (!defined($rspecstr)) {
338 339
	return GeniResponse->MalformedArgsResponse();
    }
340 341 342 343
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper characters in rspec");
    }
344
    my $credential = GeniCredential->CreateFromSigned($credstr);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
345 346 347 348
    if (!defined($credential)) {
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not create GeniCredential object");
    }
349 350 351
    #
    # Make sure the credential was issued to the caller.
    #
352
    if ($credential->owner_uuid() ne $ENV{'GENIUUID'}) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
353
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
354
				    "This is not your credential!");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
355
    }
356
    if ($isupdate) {
357
	$ticket = GeniTicket->CreateFromSignedTicket($tickstr);
358 359 360 361 362
	if (!defined($ticket)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not create GeniTicket object");
	}
    }
363
    return GetTicketAux($credential,
364
			$rspecstr, $isupdate, $impotent, 0, 1, $ticket);
365
}
366

367
sub GetTicketAux($$$$$$$)
368
{
369 370
    my ($credential, $rspecstr, $isupdate, $impotent, $v2, $level,
	$ticket) = @_;
371
    
372 373 374 375 376 377
    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));
378
    
379 380
    my $slice_uuid = $credential->target_uuid();
    my $user_uuid  = $credential->owner_uuid();
381
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
382
    #
383
    # Create slice from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384 385 386
    #
    my $slice = GeniSlice->Lookup($slice_uuid);
    if (!defined($slice)) {
387 388 389 390 391
	if ($isupdate) {
	    print STDERR "Could not locate slice $slice_uuid for Update\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"No slice found for UpdateTicket");
	}
392
	$slice = CreateSliceFromCertificate($credential);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
393
	if (!defined($slice)) {
394
	    print STDERR "Could not create $slice_uuid\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
395
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
396
					"Could not create slice");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
397
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
398 399
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
400
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
401 402
    # Ditto the user.
    #
403
    my $user = CreateUserFromCertificate($credential->owner_cert());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
404
    if (!defined($user)) {
405 406 407 408 409
	if ($isupdate) {
	    print STDERR "Could not locate $user_uuid for UpdateTicket\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"No user found for UpdateTicket");
	}
410
	return GeniResponse->Create(GENIRESPONSE_ERROR);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
411
    }
412
    return GetTicketAuxAux($slice, $user, $rspecstr,
413
			   $isupdate, $impotent, $v2, $level, $ticket, [$credential]);
414
}
415
sub GetTicketAuxAux($$$$$$$$$)
416
{
417 418
    my ($slice, $user, $rspecstr, 
        $isupdate, $impotent, $v2, $level, $ticket, $credentials) = @_;
419 420 421 422 423 424 425 426 427 428 429 430 431
    my $response    = undef;
    my $restorevirt = 0;	# Flag to restore virtual state
    my $restorephys = 0;	# Flag to restore physical state

    #
    # 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);
    }

432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449
    #
    # Run xmllint on the rspec to catch format errors.
    #
    my ($fh, $filename) = tempfile(UNLINK => 0);
    if (!defined($fh)) {
	print STDERR "Could not create temp file for rspec\n";
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }
    print $fh $rspecstr;
    close($fh);
    my $xmlerrors = `$XMLLINT --noout $filename 2>&1`;
    unlink($filename);
    if ($?) {
	return GeniResponse->Create(GENIRESPONSE_ERROR,
				    $xmlerrors,
				    "rspec is not well formed");
    }

450 451
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
452
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
453
				    "Error Parsing rspec XML");
454
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
455

Leigh B. Stoller's avatar
Leigh B. Stoller committed
456 457 458 459 460
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
    if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
461 462 463 464 465 466 467 468 469 470 471 472 473 474
	    # Cannot get the value, say no.
	    $allow_externalusers = 0;
    }

    # Figure out if user has a credentials that exempts him
    # from the following policy. If external users are blocked access
    # and he presents a credential that exempts him from it, 
    # then he should get access.
    my $isExempted = 0;
    foreach my $credential (@$credentials) {
      if (1 == GeniXML::PolicyExists('allow_externalusers', $credential)) {
        $isExempted = 1;
        last;
      }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
475
    }
476 477 478

    if (!$allow_externalusers && !$isExempted && !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
479 480 481 482
				    "External users temporarily denied");
    }
    
    #
483
    # For now all tickets expire very quickly (minutes), but once the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
484
    # ticket is redeemed, it will expire according to the rspec request.
485 486 487
    # If nothing specified in the rspec, then it will expire when the
    # slice record expires, which was given by the expiration time of the
    # slice credential.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
488
    #
489 490
    my $expires = GeniXML::GetText("valid_until", $rspec);
    if (defined($expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
491 492 493 494 495 496 497 498 499 500 501 502
	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");
	}
	
	#
503
	# Do we need a policy limit?
504 505 506 507
  # A sitevar controls the sliver lifetime.
  #
  my $max_sliver_lifetime = 0;
  if (!TBGetSiteVar('protogeni/max_sliver_lifetime', \$max_sliver_lifetime)){
508 509
	    # Cannot get the value, default it to 90 days.
	    $max_sliver_lifetime = 90;
510 511 512 513 514
  }

  # Check if the user has a credential that lets him obtain slivers
  # with extended sliver lifetime. If so allow him to get sliver.
  foreach my $credential (@$credentials) {
515 516 517 518 519 520
      my $nodes = GeniXML::FindNodesNS("//n:max_sliver_lifetime",
          $credential->extensions(), $GeniUtil::EXTENSIONS_NS);
      if ($nodes->size > 0) {
          $max_sliver_lifetime = int($nodes->pop()->string_value);
          last;
      }
521
  }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
522
	my $diff = $when - time();
523
	if ($diff < (60 * 5) || $diff > (3600 * 24 * $max_sliver_lifetime)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
524 525 526
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"valid_until out of range");
	}
527 528 529 530 531 532

	#
	# Must be before the slice expires.
	#
	my $slice_expires = $slice->expires();
	if (defined($slice_expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
533
	    $slice_expires = str2time($slice_expires);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
534
	    if ($when > $slice_expires) {
535 536 537 538
		return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "valid_until is past slice expiration");
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
539
    }
540 541 542 543 544 545 546

    #
    # Lock the ticket so it cannot be released.
    #
    if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
547 548 549
    if (defined($ticket)) {
	$ticket->SetSlice($slice);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
550 551 552 553 554 555
    
    #
    #
    # Lock the slice from further access.
    #
    if ($slice->Lock() != 0) {
556 557 558
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->BusyResponse("slice");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
559
    }
560 561 562
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
563 564
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
565 566 567
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
568 569 570 571 572 573 574 575
    # Ditto for expired.
    if ($slice->IsExpired()) {
	$slice->UnLock();
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->Create(GENIRESPONSE_REFUSED, undef,
				    "Slice has expired");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
576

577
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
578
    # For now, there can be only a single toplevel aggregate per slice.
579
    # The existence of an aggregate means the slice is active here. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
580
    #
581
    my $aggregate = GeniAggregate->SliceAggregate($slice);
582 583 584 585 586
    if (!$isupdate) {
	if (defined($aggregate)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Already have an aggregate for slice");
	    goto bad;
587 588
	}
    }
589 590 591 592 593
    elsif ($v2 && $level && !defined($ticket) && !defined($aggregate)) {
	print STDERR "No aggregate for $slice in version two API\n";
	$response = GeniResponse->Create(GENIRESPONSE_ERROR);
	goto bad;
    }
594 595 596 597

    #
    # Firewall hack; just a flag in the rspec for now.
    #
598 599 600
    my $needsfirewall = GeniXML::GetText("needsfirewall", $rspec);
    if (defined($needsfirewall)) {
	if ($slice->SetFirewallFlag($needsfirewall) != 0) {
601 602
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto bad;
603 604
	}
    }
605 606

    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
607
    # We need this now so we can form a virtual topo.
608
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
609 610 611 612 613 614 615 616
    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();
617 618 619 620 621

    #
    # Mark the experiment locally as coming from the cooked interface.
    # This changes what tmcd returns to the local nodes.
    #
622
    my $generated_by = GeniXML::GetText("generated_by", $rspec);
623 624
    if (defined($generated_by) &&
	$generated_by eq "libvtop") {
625 626 627 628
	$slice_experiment->Update({"geniflags" =>
				       $Experiment::EXPT_GENIFLAGS_EXPT|
				       $Experiment::EXPT_GENIFLAGS_COOKED});
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
629 630 631 632 633 634 635 636 637 638 639 640 641
    
    #
    # 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);
642
    $virtexperiment->multiplex_factor(3);
643 644

    # This is where nodes are parked until a ticket is redeemed.
645
    # This experiment no longer has to exist.
646
    my $reserved_holding = Experiment->Lookup("GeniSlices", "reservations");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
647

Leigh B. Stoller's avatar
Leigh B. Stoller committed
648
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
649 650
    # An rspec is a structure that requests specific nodes. If those
    # nodes are available, then reserve it. Otherwise the ticket
Leigh B. Stoller's avatar
Leigh B. Stoller committed
651 652
    # cannot be granted.
    #
653 654 655
    my %namemap  = ();
    my %colomap  = ();
    my %ifacemap = ();
656
    my %vportmap = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
657
    my %nodemap  = ();
658
    my @nodeids  = ();
659
    my %lannodes = ();
660
    my @dealloc;
661 662 663 664 665 666 667 668

    #
    # 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) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686
	$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;
	}
687 688 689 690 691 692 693
	my $oldrspec;
	if ($v2 && defined($aggregate)) {
	    $oldrspec = $aggregate->GetManifest(0);
	}
	else {
	    $oldrspec = $ticket->rspec();
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
694
	
695
	foreach my $ref (GeniXML::FindNodes("n:node",
696
					    $oldrspec)->get_nodelist()) {
697
	    # Let remote nodes pass through.
698
	    next
699
		if (!GeniXML::IsLocalNode($ref));
700

701 702
	    # Skip lan nodes; they are fake.
	    next
703
		if (GeniXML::IsLanNode($ref));
704

705 706 707
	    my $node_nickname = GeniXML::GetVirtualId($ref);
	    my $colocate      = GeniXML::GetText("colocate", $ref) ||
		                GeniXML::GetText("phys_nickname", $ref);
708
	    my $resource_uuid = GeniXML::GetNodeId($ref);
709
	    my $node = GeniUtil::LookupNode($resource_uuid);
710 711
	    if (!defined($node)) {
		$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
712
				 "Bad resource $resource_uuid in ticket");
713 714 715
		goto bad;
	    }

716 717 718 719 720 721
	    #
	    # Grab the reservation. For backwards compatibility, we want
	    # to find nodes in the reservations holding area, and move them
	    # into the slice experiment. The holding area is no longer going
	    # to be used, at least not until we have a reservations system.
	    #
722
	    my $reservation = $node->Reservation();
723
	    if (defined($reservation) &&
724
		defined($reserved_holding) &&
725 726 727 728 729 730
		$reservation->SameExperiment($reserved_holding)) {
		if ($node->MoveReservation($slice_experiment)) {
		    print STDERR "Could not move $node to $slice_experiment\n";
		    goto bad;
		}
		$node->Refresh();
731 732 733 734 735 736
	    }
	    $namemap{$node_nickname} = $node;
	    $colomap{$colocate} = $node
		if (defined($colocate));
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
737

738
    print GeniXML::Serialize($rspec);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
739

740
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
741
	my $resource_uuid = GeniXML::GetNodeId($ref);
742 743 744 745 746
	my $manager_uuid  = GeniXML::GetManagerId($ref);
	my $node_nickname = GeniXML::GetVirtualId($ref);
	my $colocate      = GeniXML::GetText("colocate", $ref) ||
	                    GeniXML::GetText("phys_nickname", $ref);
	my $subnode_of    = GeniXML::GetText("subnode_of", $ref);
747
	my $virtualization_type
748
                          = GeniXML::GetText("virtualization_type", $ref);
749
	my $virtualization_subtype
750
                          = GeniXML::GetText("virtualization_subtype",
751
					     $ref);
752
	my $exclusive     = GeniXML::GetText("exclusive", $ref);
753
	my $pctype;
754
	my $osname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
755 756
	my $node;

757
	# Let remote nodes pass through.
758
	next
759
	    if (! GeniXML::IsLocalNode($ref));
760

761 762 763 764 765
	#
	# Lan nodes are fake and do not go into the virt topo. Need
	# to remember them though, for when we do the links below.
	# They are still in the returned ticket though. 
	#
766
	if (GeniXML::IsLanNode($ref)) {
767 768 769 770
	    $lannodes{$node_nickname} = $ref;
	    next;
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
771 772 773
	if (defined($virtualization_type)) {
	    if ($virtualization_type eq "emulab-vnode") {
		if (defined($virtualization_subtype)) {
774 775
		    $pctype = "pcvm";
		    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
776 777 778 779 780 781
		    if ($virtualization_subtype eq "emulab-jail") {
			$osname = "FBSD-JAIL";
		    }
		    elsif ($virtualization_subtype eq "emulab-openvz") {
			$osname = "OPENVZ-STD";
		    }
782 783 784 785
		    elsif ($virtualization_subtype eq "emulab-spp") {
			$osname = "SPPVM-FAKE";
			$pctype = "sppvm";
			# Lets force to shared node.
786 787 788 789 790 791 792 793
			if (! GeniXML::SetText("exclusive", $ref, 0)) {
			    $response
				= GeniResponse->Create(GENIRESPONSE_BADARGS,
						       undef,
						       "Malformed rspec: Cannot set exclusive tag to false");
			    goto bad;
			}
			$exclusive = 0;
794 795
			# Kludge for libvtop.
			$virtexperiment->multiplex_factor(1);
796
			$virtexperiment->encap_style("vlan");
797
		    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
798 799 800 801 802 803 804 805
		}
		else {
		    goto raw;
		}
	    }
	    else {
	      raw:
		# Lets force to exclusive real node.
806 807 808 809 810 811 812 813 814 815 816 817 818
		if (! GeniXML::SetText("exclusive", $ref, 1)) {
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
						     "Malformed rspec: Cannot set exclusive tag to true");
		    goto bad;
		}
		$exclusive = 1;
		if (! GeniXML::SetText("virtualization_type", $ref, "raw")) {
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
						     "Malformed rspec: Cannot set virtualization_type to raw");
		    goto bad;
		}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
819 820 821 822
	    }
	}
	else {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
823
				     "Must provide a virtualization_type");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
824 825 826
	    goto bad;

	}
827 828 829 830 831 832
	if (!defined($node_nickname)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Must provide a virtual_id for nodes");
	    goto bad;
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
833
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
834
	# Allow wildcarding.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
835
	#
836 837 838 839 840 841
	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};
842
	    }
843 844 845 846 847 848 849 850
	    # If the node still isn't bound and doesn't have a pctype,
	    # use the user-specified one.
	    if (! defined($node) && ! defined($pctype)) {
		my $usertype = GeniXML::FindFirst("n:node_type", $ref);
		if (defined($usertype)) {
		    $pctype = GeniXML::GetText("type_name", $usertype);
		}
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
851 852
	}
	else {
853
	    $node = GeniUtil::LookupNode($resource_uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
854 855 856 857 858 859 860

	    if (!defined($node)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Bad resource $resource_uuid");
		goto bad;
	    }
861 862
	    $pctype = $node->type()
		if (!defined($pctype));
863 864
	}
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
865
	# If no osname by this point, try for the default.
866 867
	#
	if (defined($node) && !defined($osname)) {
868 869 870 871 872
	    if (defined($node->default_osid())) {	    
		my $osinfo = OSinfo->Lookup($node->default_osid());
		$osname = $osinfo->osname()
		    if (defined($osinfo));
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
873
	}
874 875 876
	# The slot does not like to be NULL.
	$osname = ""
	    if (!defined($osname));
877
	
878 879 880
	# Need some kind of default.
	$pctype = "pc"
	    if (!defined($pctype));
881
	
882 883 884 885 886
	my $nodeblob = {"vname"   => $node_nickname,
			"type"    => $pctype,
			"osname"  => $osname,
			"ips"     => '', # deprecated
			"cmd_line"=> '', # bogus
Leigh B. Stoller's avatar
Leigh B. Stoller committed
887 888
			"fixed"   => (defined($subnode_of) ? $subnode_of :
				      defined($node) ? $node->node_id() : ""),
889
			};
890 891

	# Tarball and startup command.
892
	my $startupcmd = GeniXML::GetText("startup_command", $ref);
893
	if (defined($startupcmd)) {
894 895 896 897 898 899 900 901 902
	    if (! TBcheck_dbslot($startupcmd, "virt_nodes", "startupcmd",
			 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Invalid startup command");
		goto bad;
	    }
	    $nodeblob->{'startupcmd'} = $startupcmd;
	}
903
	my $tarfiles = GeniXML::GetText("tarfiles", $ref);
904
	if (defined($tarfiles)) {
905
	    if (! TBcheck_dbslot($tarfiles, "virt_nodes", "tarfiles",
906 907 908 909 910 911
			 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Invalid tarfiles");
		goto bad;
	    }
912
	    $nodeblob->{'tarfiles'} = $tarfiles;
913 914 915 916 917 918 919 920
	}

	my $virtnode = $virtexperiment->NewTableRow("virt_nodes", $nodeblob);
	if (!defined($virtnode)) {
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					     "Error creating virtnode");
	    goto bad;
	}
921

Leigh B. Stoller's avatar
Leigh B. Stoller committed
922 923 924 925 926 927 928 929 930 931
	$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};
	
932 933 934 935
	#
	# Look for interface forward declarations that will be used later
	# in the link specifications. 
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
936
	next
937
	    if (!defined(GeniXML::FindFirst("n:interface", $ref)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
938
	
939
	foreach my $linkref (GeniXML::FindNodes("n:interface",
940
						$ref)->get_nodelist()) {
941
	    my $virtual_id   = GeniXML::GetText("virtual_id", $linkref);
942 943 944 945 946 947 948 949 950 951

	    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}));

Leigh B. Stoller's avatar
Leigh B. Stoller committed
952 953 954
	    # port counter.
	    my $vport = scalar(keys(%{ $ifacemap{$node_nickname} }));

955
	    # Store reference so we can munge it below. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
956 957
	    $ifacemap{$node_nickname}->{$virtual_id} = {"rspec" => $linkref,
							"vport" => $vport};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
958

Leigh B. Stoller's avatar
Leigh B. Stoller committed
959
	    # This is used after the mapper runs since it uses vname:vport.
960
	    $vportmap{"$node_nickname:$vport"} = $linkref;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
961
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
962 963
    }

964
    goto skiplinks
965
	if (!defined(GeniXML::FindFirst("n:link", $rspec)));
966
    
967 968 969 970
    #
    # Now deal with links for wildcarded nodes. We need to fill in the
    # node_uuid.
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
971 972
    my $linknum = 1;
    
973
    foreach my $linkref (GeniXML::FindNodes("n:link",
974
					    $rspec)->get_nodelist()) {
975
	my $lanname    = GeniXML::GetVirtualId($linkref);
976 977
	my $link_type  = GeniXML::GetText("link_type", $linkref);
	my $istunnel   = (defined($link_type) && $link_type eq "tunnel");
978 979
	my @interfaces = GeniXML::FindNodes("n:linkendpoints | ".
					    "n:interface_ref",
980
					    $linkref)->get_nodelist();
981
	my %managers   = undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
982
	my $ifacenum   = 1;
983
	my $trivial_ok = 0;
984

985
	if (!defined($lanname)) {
986 987 988 989
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Must provide a virtual_id for links");
	    goto bad;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
990

991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007
	#
	# Look for managers list; optional for now. If not specified then
	# we assume the link is for thie CM.
	#
	if (GeniXML::FindNodes("n:component_manager", $linkref)) {
	    %managers = map { GeniXML::GetText("id", $_) => $_ } 
	                      GeniXML::FindNodes("n:component_manager",
						 $linkref)->get_nodelist();

	    #
	    # Initial check for the entire link. We check on a per interface
	    # case below.
	    #
	    next
		if (!exists($managers{$ENV{'MYURN'}}));
	}

1008 1009 1010 1011 1012 1013 1014
	#
	# Ick. Before we create the virt_lan_lans entry, we have to check
	# inside to see if one of the interfaces is connected to a lan
	# node. In this case, we want to reuse (if its been created) the
	# lan name, rather then a bunch of links with one interface, which
	# would result in a bogus topology. 
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1015
	if (!$istunnel) {
1016
	    foreach my $ref (@interfaces) {
1017 1018 1019
		my $node_nickname =
		    GeniXML::GetText("virtual_node_id", $ref) ||
		    GeniXML::GetText("node_nickname", $ref);
1020 1021 1022 1023 1024 1025 1026 1027 1028

		if (exists($lannodes{$node_nickname})) {
		    $lanname = $node_nickname;
		}
	    }
	    if (!defined($virtexperiment->Find("virt_lan_lans", $lanname))) {
		$virtexperiment->NewTableRow("virt_lan_lans",
					     {"vname" => $lanname});
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1029
	}
1030
	
1031
	foreach my $ref (@interfaces) {
1032 1033 1034 1035
	    my $node_nickname = GeniXML::GetText("virtual_node_id", $ref) ||
		                GeniXML::GetText("node_nickname", $ref);
	    my $iface_id = GeniXML::GetText("virtual_interface_id", $ref) ||
		           GeniXML::GetText("iface_name", $ref);
1036

1037
	    if (!defined($node_nickname)) {
1038 1039
		$response =
		    GeniResponse->Create(GENIRESPONSE_ERROR, undef,
1040
				 "$lanname: Need node id for links");
1041 1042 1043 1044 1045
		goto bad;
	    }
	    if (!defined($iface_id)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_ERROR, undef,
1046
				 "$lanname: Need interface id for links");
1047 1048 1049
		goto bad;
	    }

1050 1051 1052 1053 1054 1055 1056 1057 1058
	    #
	    # Look for links that are really lans; one of the interfaces
	    # is on a fake lan node, which we caught above. Just skip it
	    # since in the virt topo, a lan is just a link with more then
	    # two nodes.
	    #
	    next
		if (exists($lannodes{$node_nickname}));

1059
	    if ($istunnel) {
1060
		# Might be the other side. Skip for now; might bite later.
1061 1062
		next
		    if (!exists($namemap{$node_nickname}));
1063

1064 1065 1066
		# Not doing anything else.
		next;
	    }