GeniCM.pm.in 113 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
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }

143 144 145 146
    my $credential = CheckCredential($cred);
    return $credential
	if (GeniResponse::IsResponse($credential));

147
    if ($type eq "node") {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
148 149 150
	my $node;
	
	if (defined($uuid)) {
151
	    $node= GeniUtil::LookupNode($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
152 153
	}
	else {
154
	    $node= GeniUtil::LookupNode($hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
	}
156
	if (! defined($node)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
157 158 159
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					undef, "Nothing here by that name");
	}
160

161
	my $rspec = GetAdvertisement(0, $node->node_id(), "0.1");
162 163 164 165
	if (! defined($rspec)) {
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not start avail");
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
166 167
	
	# Return a blob.
168
	my $blob = { "hrn"          => "${PGENIDOMAIN}." . $node->node_id(),
Leigh B. Stoller's avatar
Leigh B. Stoller committed
169
		     "uuid"         => $node->uuid(),
170
		     "role"	    => $node->role(),
171 172
		     "hostname"     =>
			 GeniUtil::FindHostname($node->node_id()),
173 174
		     "physctrl"     => 
			 Interface->LookupControl( $node->phys_nodeid() )->IP(),
175 176
		     "urn"          => GeniHRN::Generate( $OURDOMAIN,
							  "node",
177 178
							  $node->node_id() ),
		     "rspec"        => $rspec
Leigh B. Stoller's avatar
Leigh B. Stoller committed
179 180 181 182 183 184 185
		   };

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
186 187 188 189 190 191
#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
192
    my $credstr   = $argref->{'credential'};
193
    my $available = $argref->{'available'} || 0;
194 195 196 197 198
    my $compress  = $argref->{'compress'} || 0;

    my $credential = CheckCredential($credstr);
    return $credential
	if (GeniResponse::IsResponse($credential));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
199

200
    return DiscoverResourcesAux($available, $compress, [$credential]);
201 202
}
# Helper function for V2.
203
sub DiscoverResourcesAux($$$)
204
{
205
    my ($available, $compress, $credentials) = @_;
206
    my $user_urn  = $ENV{'GENIRN'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
207

208 209 210
    # 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.
211 212 213 214 215 216
    if (defined($available) && ref($available) eq 'Frontier::RPC2::Boolean') {
	$available = $available->value;
    }
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
217

Leigh B. Stoller's avatar
Leigh B. Stoller committed
218 219 220 221 222
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
    if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
223 224
	      # Cannot get the value, say no.
	      $allow_externalusers = 0;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
225
    }
226 227 228 229 230 231 232

    # 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) {
233
        if (GeniXML::PolicyExists('allow_externalusers', $credential) == 1) {
234 235 236 237 238 239
        $isExempted = 1;
        last;
      }
    }

    if (!$allow_externalusers && !$isExempted) {
240
	my $user = GeniUser->Lookup($user_urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
241 242 243 244 245 246 247
	# 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
248
    #
249
    # Acquire the advertisement from ptopgen and compress it if requested.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
250
    #
251
    my $xml = GetAdvertisement($available, undef, "0.2");
252
    if (! defined($xml)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
253 254 255 256
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start avail");
    }

257 258 259 260 261 262
    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
263 264
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
265

266 267 268
#
# Use ptopgen in xml mode to spit back an xml file. 
#
269
sub GetAdvertisement($$$)
270
{
271
    my ($available, $pc, $version) = @_;
272 273
    my $xml = undef;

274
    my $invocation = "$PTOPGEN -x -g $version -r -p GeniSlices";
275 276 277 278 279
    $invocation .= " -a" unless $available;
    if (defined($pc)) {
	$invocation .= " -1 $pc";
    }
    if (open(AVAIL, "$invocation |")) {
280
	$xml = "";
281 282 283 284 285 286 287 288
	while (<AVAIL>) {
	    $xml .= $_;
	}
	close(AVAIL);
    }
    return $xml;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
289
#
290
# Update a ticket with a new rspec.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
291
#
292
sub UpdateTicket($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
293 294
{
    my ($argref) = @_;
295 296 297 298 299 300 301 302 303 304

    return GetTicket($argref, 1);
}

#
# Respond to a GetTicket request. 
#
sub GetTicket($;$)
{
    my ($argref, $isupdate) = @_;
305
    my $rspecstr   = $argref->{'rspec'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306
    my $impotent   = $argref->{'impotent'};
307 308
    my $credstr    = $argref->{'credential'};
    my $tickstr    = $argref->{'ticket'};
309 310 311 312 313 314 315
    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
316

317
    if (! defined($credstr)) {
318
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
319
    }
320
    if (!defined($rspecstr)) {
321 322
	return GeniResponse->MalformedArgsResponse();
    }
323 324 325 326
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper characters in rspec");
    }
327 328 329 330
    my $credential = CheckCredential($credstr);
    return $credential
	if (GeniResponse::IsResponse($credential));

331
    if ($isupdate) {
332 333 334
	$ticket = CheckTicket($tickstr);
	return $ticket
	    if (GeniResponse::IsResponse($ticket));
335
    }
336
    return GetTicketAux($credential,
337
			$rspecstr, $isupdate, $impotent, 0, 1, $ticket);
338
}
339

340
sub GetTicketAux($$$$$$$)
341
{
342 343
    my ($credential, $rspecstr, $isupdate, $impotent, $v2, $level,
	$ticket) = @_;
344
    
345 346 347 348 349 350
    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));
351
    
352 353
    my $slice_urn = $credential->target_urn();
    my $user_urn  = $credential->owner_urn();
354
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
355
    #
356
    # Create user from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
357
    #
358 359
    my $user = CreateUserFromCertificate($credential->owner_cert());
    if (!defined($user)) {
360
	if ($isupdate) {
361
	    print STDERR "Could not locate $user_urn for UpdateTicket\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
362
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
363
					"No user found for UpdateTicket");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
364
	}
365
	return GeniResponse->Create(GENIRESPONSE_ERROR);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
366 367
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
368
    #
369
    # Create slice from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
370
    #
371 372
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
373
	if ($isupdate) {
374
	    print STDERR "Could not locate slice $slice_urn for Update\n";
375
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
376 377 378 379 380 381 382
					"No slice found for UpdateTicket");
	}
	$slice = CreateSliceFromCertificate($credential, $user);
	if (!defined($slice)) {
	    print STDERR "Could not create $slice_urn\n";
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					"Could not create slice");
383
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
384
    }
385
    
386
    return GetTicketAuxAux($slice, $user, $rspecstr,
387 388
			   $isupdate, $impotent, $v2, $level, $ticket,
			   [$credential]);
389
}
390
sub GetTicketAuxAux($$$$$$$$$)
391
{
392 393
    my ($slice, $user, $rspecstr, 
        $isupdate, $impotent, $v2, $level, $ticket, $credentials) = @_;
394 395 396 397 398 399 400 401 402 403 404 405 406
    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);
    }

407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
    #
    # 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");
    }

425 426
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
427
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
428
				    "Error Parsing rspec XML");
429
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
430

Leigh B. Stoller's avatar
Leigh B. Stoller committed
431 432 433 434 435
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
    if (!TBGetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
436 437 438 439 440 441 442 443 444 445 446 447 448 449
	    # 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
450
    }
451 452 453

    if (!$allow_externalusers && !$isExempted && !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
454 455 456 457
				    "External users temporarily denied");
    }
    
    #
458
    # For now all tickets expire very quickly (minutes), but once the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
459
    # ticket is redeemed, it will expire according to the rspec request.
460 461 462
    # 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
463
    #
464 465
    my $expires = GeniXML::GetText("valid_until", $rspec);
    if (defined($expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
466 467 468 469 470 471 472 473 474 475 476 477
	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");
	}
	
	#
478
	# Do we need a policy limit?
479 480 481 482
  # A sitevar controls the sliver lifetime.
  #
  my $max_sliver_lifetime = 0;
  if (!TBGetSiteVar('protogeni/max_sliver_lifetime', \$max_sliver_lifetime)){
483 484
	    # Cannot get the value, default it to 90 days.
	    $max_sliver_lifetime = 90;
485 486 487 488 489
  }

  # 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) {
490 491 492 493 494 495
      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;
      }
496
  }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
497
	my $diff = $when - time();
498
	if ($diff < (60 * 5) || $diff > (3600 * 24 * $max_sliver_lifetime)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
499 500 501
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"valid_until out of range");
	}
502 503 504 505 506 507

	#
	# Must be before the slice expires.
	#
	my $slice_expires = $slice->expires();
	if (defined($slice_expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
508
	    $slice_expires = str2time($slice_expires);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
509
	    if ($when > $slice_expires) {
510 511 512 513
		return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "valid_until is past slice expiration");
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
514
    }
515 516 517 518 519 520 521

    #
    # Lock the ticket so it cannot be released.
    #
    if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
522 523 524
    if (defined($ticket)) {
	$ticket->SetSlice($slice);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
525 526 527 528 529 530
    
    #
    #
    # Lock the slice from further access.
    #
    if ($slice->Lock() != 0) {
531 532 533
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->BusyResponse("slice");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
534
    }
535 536 537
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
538 539
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
540 541 542
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
543 544 545 546 547 548 549 550
    # 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
551

552
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
553
    # For now, there can be only a single toplevel aggregate per slice.
554
    # The existence of an aggregate means the slice is active here. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
555
    #
556
    my $aggregate = GeniAggregate->SliceAggregate($slice);
557 558 559 560 561
    if (!$isupdate) {
	if (defined($aggregate)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Already have an aggregate for slice");
	    goto bad;
562 563
	}
    }
564 565 566 567 568
    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;
    }
569 570 571 572

    #
    # Firewall hack; just a flag in the rspec for now.
    #
573 574 575
    my $needsfirewall = GeniXML::GetText("needsfirewall", $rspec);
    if (defined($needsfirewall)) {
	if ($slice->SetFirewallFlag($needsfirewall) != 0) {
576 577
	    $response = GeniResponse->Create(GENIRESPONSE_ERROR);
	    goto bad;
578 579
	}
    }
580 581

    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
582
    # We need this now so we can form a virtual topo.
583
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
584 585 586 587 588 589 590 591
    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();
592 593 594 595 596

    #
    # Mark the experiment locally as coming from the cooked interface.
    # This changes what tmcd returns to the local nodes.
    #
597
    my $generated_by = GeniXML::GetText("generated_by", $rspec);
598 599
    if (defined($generated_by) &&
	$generated_by eq "libvtop") {
600 601 602 603
	$slice_experiment->Update({"geniflags" =>
				       $Experiment::EXPT_GENIFLAGS_EXPT|
				       $Experiment::EXPT_GENIFLAGS_COOKED});
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
604 605 606 607 608 609 610 611 612 613 614 615 616
    
    #
    # 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);
617
    $virtexperiment->multiplex_factor(3);
618 619

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
623
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
624 625
    # 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
626 627
    # cannot be granted.
    #
628 629 630
    my %namemap  = ();
    my %colomap  = ();
    my %ifacemap = ();
631
    my %vportmap = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
632
    my %nodemap  = ();
633
    my @nodeids  = ();
634
    my %lannodes = ();
635
    my @dealloc;
636 637 638 639 640 641 642 643

    #
    # 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
644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661
	$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;
	}
662 663 664 665 666 667 668
	my $oldrspec;
	if ($v2 && defined($aggregate)) {
	    $oldrspec = $aggregate->GetManifest(0);
	}
	else {
	    $oldrspec = $ticket->rspec();
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
669
	
670
	foreach my $ref (GeniXML::FindNodes("n:node",
671
					    $oldrspec)->get_nodelist()) {
672
	    # Let remote nodes pass through.
673
	    next
674
		if (!GeniXML::IsLocalNode($ref));
675

676 677
	    # Skip lan nodes; they are fake.
	    next
678
		if (GeniXML::IsLanNode($ref));
679

680 681 682
	    my $node_nickname = GeniXML::GetVirtualId($ref);
	    my $colocate      = GeniXML::GetText("colocate", $ref) ||
		                GeniXML::GetText("phys_nickname", $ref);
683
	    my $resource_uuid = GeniXML::GetNodeId($ref);
684
	    my $node = GeniUtil::LookupNode($resource_uuid);
685 686
	    if (!defined($node)) {
		$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
687
				 "Bad resource $resource_uuid in ticket");
688 689 690
		goto bad;
	    }

691 692 693 694 695 696
	    #
	    # 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.
	    #
697
	    my $reservation = $node->Reservation();
698
	    if (defined($reservation) &&
699
		defined($reserved_holding) &&
700 701 702 703 704 705
		$reservation->SameExperiment($reserved_holding)) {
		if ($node->MoveReservation($slice_experiment)) {
		    print STDERR "Could not move $node to $slice_experiment\n";
		    goto bad;
		}
		$node->Refresh();
706 707 708 709 710 711
	    }
	    $namemap{$node_nickname} = $node;
	    $colomap{$colocate} = $node
		if (defined($colocate));
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
712

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

715
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
716
	my $resource_uuid = GeniXML::GetNodeId($ref);
717 718 719 720 721
	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);
722
	my $virtualization_type
723
                          = GeniXML::GetText("virtualization_type", $ref);
724
	my $virtualization_subtype
725
                          = GeniXML::GetText("virtualization_subtype",
726
					     $ref);
727
	my $exclusive     = GeniXML::GetText("exclusive", $ref);
728
	my $pctype;
729
	my $osname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
730 731
	my $node;

732
	# Let remote nodes pass through.
733
	next
734
	    if (! GeniXML::IsLocalNode($ref));
735

736 737 738 739 740
	#
	# 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. 
	#
741
	if (GeniXML::IsLanNode($ref)) {
742 743 744 745
	    $lannodes{$node_nickname} = $ref;
	    next;
	}

746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790
	#
	# Check for disk_image request. Specified as a URN. 
	#
	my $diskref = GeniXML::FindFirst("n:disk_image", $ref);
	if (defined($diskref)) {
	    my $dname = GeniXML::GetText("name", $diskref);

	    if (defined($dname)) {
		if (! GeniHRN::IsValid($dname)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
		my ($auth,$type,$id) = GeniHRN::Parse($dname);
		my ($ospid,$os) = ($id =~ m{(.*)//(.*)});
		if ($type ne "image" || !defined($ospid) || !defined($os)){
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Malformed image URN: $dname");
		    goto bad;
		}
		#
		# For now, the project has to be emulab-ops. 
		#
		if ($ospid ne TBOPSPID()) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				 "Illegal project name in URN: $dname");
		    goto bad;
		}
		my $osinfo = OSinfo->LookupByName($os);
		if (!defined($osinfo)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					     "Bad osname in URN: $dname");
		    goto bad;
		}
		#
		# This is only going to be used in raw mode. 
		#
		$osname = $os;
	    }
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
791 792 793
	if (defined($virtualization_type)) {
	    if ($virtualization_type eq "emulab-vnode") {
		if (defined($virtualization_subtype)) {
794 795
		    $pctype = "pcvm";
		    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
796 797 798 799 800 801
		    if ($virtualization_subtype eq "emulab-jail") {
			$osname = "FBSD-JAIL";
		    }
		    elsif ($virtualization_subtype eq "emulab-openvz") {
			$osname = "OPENVZ-STD";
		    }
802 803 804 805
		    elsif ($virtualization_subtype eq "emulab-spp") {
			$osname = "SPPVM-FAKE";
			$pctype = "sppvm";
			# Lets force to shared node.
806 807 808 809
			if (! GeniXML::SetText("exclusive", $ref, 0)) {
			    $response
				= GeniResponse->Create(GENIRESPONSE_BADARGS,
						       undef,
810 811
				       "Malformed rspec: ".
				       "Cannot set exclusive tag to false");
812 813 814
			    goto bad;
			}
			$exclusive = 0;
815 816
			# Kludge for libvtop.
			$virtexperiment->multiplex_factor(1);
817
			$virtexperiment->encap_style("vlan");
818
		    }
819 820 821 822
		    elsif ($virtualization_subtype eq "raw") {
			$pctype = undef;
			goto raw;
		    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
823 824 825 826 827 828 829 830
		}
		else {
		    goto raw;
		}
	    }
	    else {
	      raw:
		# Lets force to exclusive real node.
831 832 833
		if (! GeniXML::SetText("exclusive", $ref, 1)) {
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
834
			"Malformed rspec: Cannot set exclusive tag to true");
835 836 837 838 839 840
		    goto bad;
		}
		$exclusive = 1;
		if (! GeniXML::SetText("virtualization_type", $ref, "raw")) {
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
841
			"Malformed rspec: Cannot set virtualization_type to raw");
842 843
		    goto bad;
		}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
844 845 846 847
	    }
	}
	else {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
848
				     "Must provide a virtualization_type");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
849 850 851
	    goto bad;

	}
852 853 854 855 856 857
	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
858
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
859
	# Allow wildcarding.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
860
	#
861 862 863 864 865 866
	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};
867
	    }
868 869 870 871 872 873 874 875
	    # 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
876 877
	}
	else {
878
	    $node = GeniUtil::LookupNode($resource_uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
879 880 881 882 883 884 885

	    if (!defined($node)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Bad resource $resource_uuid");
		goto bad;
	    }
886 887
	    $pctype = $node->type()
		if (!defined($pctype));
888 889
	}
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
890
	# If no osname by this point, try for the default.
891 892
	#
	if (defined($node) && !defined($osname)) {
893 894 895 896 897
	    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
898
	}
899 900 901
	# The slot does not like to be NULL.
	$osname = ""
	    if (!defined($osname));
902
	
903 904 905
	# Need some kind of default.
	$pctype = "pc"
	    if (!defined($pctype));
906
	
907 908 909 910 911
	my $nodeblob = {"vname"   => $node_nickname,
			"type"    => $pctype,
			"osname"  => $osname,
			"ips"     => '', # deprecated
			"cmd_line"=> '', # bogus
Leigh B. Stoller's avatar
Leigh B. Stoller committed
912 913
			"fixed"   => (defined($subnode_of) ? $subnode_of :
				      defined($node) ? $node->node_id() : ""),
914
			};
915 916

	# Tarball and startup command.
917
	my $startupcmd = GeniXML::GetText("startup_command", $ref);
918
	if (defined($startupcmd)) {
919 920 921 922 923 924 925 926 927
	    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;
	}
928
	my $tarfiles = GeniXML::GetText("tarfiles", $ref);
929
	if (defined($tarfiles)) {
930
	    if (! TBcheck_dbslot($tarfiles, "virt_nodes", "tarfiles",
931 932 933 934 935 936
			 TBDB_CHECKDBSLOT_WARN|TBDB_CHECKDBSLOT_ERROR)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Invalid tarfiles");
		goto bad;
	    }
937
	    $nodeblob->{'tarfiles'} = $tarfiles;
938 939 940 941 942 943 944 945
	}

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
947 948 949 950 951 952 953 954 955 956
	$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};
	
957 958 959 960
	#
	# Look for interface forward declarations that will be used later
	# in the link specifications. 
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
961
	next
962
	    if (!defined(GeniXML::FindFirst("n:interface", $ref)));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
963
	
964
	foreach my $linkref (GeniXML::FindNodes("n:interface",
965
						$ref)->get_nodelist()) {
966
	    my $virtual_id   = GeniXML::GetText("virtual_id", $linkref);
967 968 969 970 971 972 973 974 975 976

	    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
977 978 979
	    # port counter.
	    my $vport = scalar(keys(%{ $ifacemap{$node_nickname} }));

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
984
	    # This is used after the mapper runs since it uses vname:vport.
985
	    $vportmap{"$node_nickname:$vport"} = $linkref;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
986
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
987 988
    }

989
    goto skiplinks
990
	if (!defined(GeniXML::FindFirst("n:link", $rspec)));
991
    
992 993 994 995
    #
    # Now deal with links for wildcarded nodes. We need to fill in the
    # node_uuid.
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
996 997
    my $linknum = 1;
    
998
    foreach my $linkref (GeniXML::FindNodes("n:link",
999
					    $rspec)->get_nodelist()) {
1000
	my $lanname    = GeniXML::GetVirtualId($linkref);
1001 1002
	my $link_type  = GeniXML::GetText("link_type", $linkref);
	my $istunnel   = (defined($link_type) && $link_type eq "tunnel");
1003 1004
	my @interfaces = GeniXML::FindNodes("n:linkendpoints | ".
					    "n:interface_ref",
1005
					    $linkref)->get_nodelist();
1006
	my %managers   = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1007
	my $ifacenum   = 1;
1008
	my $trivial_ok = 0;
1009

1010
	if (!defined($lanname)) {
1011 1012 1013 1014
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Must provide a virtual_id for links");
	    goto bad;
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1015

1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032
	#
	# 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'}}));
	}

1033 1034 1035 1036 1037 1038 1039
	#
	# 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
1040
	if (!$istunnel) {
1041
	    foreach my $ref (@interfaces) {
1042 1043 1044
		my $node_nickname =
		    GeniXML::GetText("virtual_node_id", $ref) ||
		    GeniXML::GetText("node_nickname", $ref);
1045 1046 1047 1048 1049 1050 1051 1052 1053

		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
1054
	}
1055
	
1056
	foreach my $ref (@interfaces) {
1057 1058 1059 1060
	    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);
1061