GeniCM.pm.in 169 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1
2
#!/usr/bin/perl -wT
#
3
# GENIPUBLIC-COPYRIGHT
Leigh B Stoller's avatar
Leigh B Stoller committed
4
# Copyright (c) 2008-2012 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
# 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 ( );

use GeniDB;
use Genixmlrpc;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
22
23
use GeniResponse;
use GeniTicket;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
24
use GeniCredential;
25
use GeniCertificate;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
26
use GeniSlice;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
27
use GeniAggregate;
28
use GeniAuthority;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29
use GeniSliver;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
30
use GeniUser;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
31
use GeniRegistry;
32
use GeniUtil;
33
use GeniHRN;
34
use GeniXML;
35
use GeniUsage;
36
use libtestbed;
37
use emutil;
38
39
use EmulabConstants;
use libEmulab;
40
use Lan;
41
use Experiment;
42
use NodeType;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
43
44
use English;
use Data::Dumper;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
45
use XML::Simple;
46
use XML::LibXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47
use Date::Parse;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
48
use POSIX qw(strftime tmpnam);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
49
use Time::Local;
50
use Compress::Zlib;
51
use File::Temp qw(tempfile);
52
use MIME::Base64;
53
use Digest::SHA1 qw(sha1_hex);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
54
55
56
57
58
59
60
61

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
62
my $MAINSITE       = @TBMAINSITE@;
63
my $ELABINELAB     = @ELABINELAB@;
64
my $PGENIDOMAIN    = "@PROTOGENI_DOMAIN@";
65
my $PROTOUSER 	   = "elabman";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
66
my $CREATEEXPT     = "$TB/bin/batchexp";
67
my $ENDEXP         = "$TB/bin/endexp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
68
my $NALLOC	   = "$TB/bin/nalloc";
69
my $NFREE	   = "$TB/bin/nfree";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
70
my $AVAIL	   = "$TB/sbin/avail";
71
my $PTOPGEN	   = "$TB/libexec/ptopgen";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
72
73
my $TBSWAP	   = "$TB/bin/tbswap";
my $SWAPEXP	   = "$TB/bin/swapexp";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
74
75
my $PLABSLICE	   = "$TB/sbin/plabslicewrapper";
my $NAMEDSETUP     = "$TB/sbin/named_setup";
76
my $EXPORTS_SETUP  = "$TB/sbin/exports_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
77
78
my $VNODESETUP     = "$TB/sbin/vnode_setup";
my $GENTOPOFILE    = "$TB/libexec/gentopofile";
79
my $IPASSIGN       = "$TB/libexec/ipassign_wrapper";
80
my $TARFILES_SETUP = "$TB/bin/tarfiles_setup";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
81
82
my $MAPPER         = "$TB/bin/mapper";
my $VTOPGEN        = "$TB/bin/vtopgen";
83
my $SNMPIT         = "$TB/bin/snmpit_test";
84
my $RESERVEVLANS   = "$TB/sbin/protogeni/reservevlans";
85
my $NEWGROUP       = "$TB/bin/newgroup";
86
87
my $NEWPROJECT     = "$TB/sbin/newproj";
my $MAKEPROJECT    = "$TB/sbin/mkproj";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
88
my $PRERENDER      = "$TB/libexec/vis/prerender";
89
90
my $SUDO           = "/usr/local/bin/sudo";
my $WAP            = "$TB/sbin/withadminprivs";
91
my $XMLLINT	   = "/usr/local/bin/xmllint";
92
my $ADDAUTHORITY   = "$TB/sbin/protogeni/addauthority";
93
my $EMULAB_PEMFILE = "@prefix@/etc/genicm.pem";
94
my $TARINSTALL     = "/usr/local/bin/install-tarfile";
95
my $FWNAME	   = "fw";
96
my $API_VERSION    = 1;
97
my $USELOCALPROJ   = 0;
98
99
100
101
102
103
104
105
106
107
108

#
# 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
109
#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
110
# Respond to a Resolve request. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
111
112
113
114
115
116
#
sub Resolve($)
{
    my ($argref) = @_;
    my $uuid       = $argref->{'uuid'};
    my $cred       = $argref->{'credential'};
117
118
    my $type       = lc( $argref->{'type'} );
    my $hrn        = $argref->{'hrn'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
119
120
121
122

    if (! defined($cred)) {
	return GeniResponse->MalformedArgsResponse();
    }
123
124
125
126
    if (defined($uuid) && GeniHRN::IsValid($uuid)) {
	$hrn  = $uuid;
	$uuid = undef;
    }
127
128
129
130
131
132
133
134
135
136
137
138
    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
139
140
141
	return GeniResponse->MalformedArgsResponse();
    }
    # Allow lookup by uuid or hrn.
142
    if (! defined($uuid) && !defined( $hrn ) ) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
143
144
145
146
147
148
	return GeniResponse->MalformedArgsResponse();
    }
    if (defined($uuid) && !($uuid =~ /^[-\w]*$/)) {
	return GeniResponse->MalformedArgsResponse();
    }

149
150
151
152
    my $credential = CheckCredential($cred);
    return $credential
	if (GeniResponse::IsResponse($credential));

153
    if ($type eq "node") {
154
	require Interface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
155
156
157
	my $node;
	
	if (defined($uuid)) {
158
	    $node= GeniUtil::LookupNode($uuid);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
159
160
	}
	else {
161
	    $node= GeniUtil::LookupNode($hrn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
162
	}
163
	if (! defined($node)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
164
165
166
	    return GeniResponse->Create(GENIRESPONSE_SEARCHFAILED,
					undef, "Nothing here by that name");
	}
167

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

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

Leigh B. Stoller's avatar
Leigh B. Stoller committed
193
194
195
196
197
198
#
# Discover resources on this component, returning a resource availablity spec
#
sub DiscoverResources($)
{
    my ($argref) = @_;
199
    my $credstr   = $argref->{'credential'};
200
    my $available = $argref->{'available'} || 0;
201
    my $compress  = $argref->{'compress'} || 0;
202
    my $version   = $argref->{'rspec_version'} || undef;
203
204
205
206

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

208
209
    return DiscoverResourcesAux($available,
				$compress, $version, [$credential]);
210
211
}
# Helper function for V2.
212
sub DiscoverResourcesAux($$$$)
213
{
214
    my ($available, $compress, $version, $credentials) = @_;
215
    my $user_urn  = $ENV{'GENIRN'};
216
    $version   = "2"
217
218
219
	if (!defined($version));

    # Sanity check since this can come from client.
220
    if (! ($version eq "0.1" || $version eq "0.2" || $version eq "2"
221
222
223
	   || $version eq "3"
	   || $version eq "PG 0.1" || $version eq "PG 0.2"
	   || $version eq "PG 2")) {
224
225
226
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper version request");
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
227

228
229
230
    # 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.
231
232
233
234
235
236
    if (defined($available) && ref($available) eq 'Frontier::RPC2::Boolean') {
	$available = $available->value;
    }
    if (defined($compress) && ref($compress) eq 'Frontier::RPC2::Boolean') {
	$compress = $compress->value;
    }
237

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

    # 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) {
253
        if (GeniXML::PolicyExists('allow_externalusers', $credential) == 1) {
254
255
256
257
258
259
        $isExempted = 1;
        last;
      }
    }

    if (!$allow_externalusers && !$isExempted) {
260
	my $user = GeniUser->Lookup($user_urn, 1);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
261
262
263
264
265
266
267
	# No record means the user is remote.
	if (!defined($user) || !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
					"External users temporarily denied");
	}
    }

268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
    #
    # See if one of the credentials is a slice credential. If it is, and
    # that slice is active, pass it to ptopgen so that it includes the current
    # resources as available.
    #
    my $experiment = undef;
    foreach my $credential (@$credentials) {
	my ($auth, $type, $id) = GeniHRN::Parse($credential->target_urn());
	if ($type eq "slice") {
	    # Might not exist here yet.
	    my $slice = GeniSlice->Lookup($credential->target_urn());
	    if (defined($slice)) {
		# See if the local experiment exists yet.
		$experiment = Experiment->Lookup($slice->uuid());
	    }
	    last;
	}
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
287
    #
288
    # Acquire the advertisement from ptopgen and compress it if requested.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
289
    #
290
    my $xml = GetAdvertisement($available, undef, $version, $experiment);
291
    if (! defined($xml)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
292
293
294
295
	return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
				    "Could not start avail");
    }

296
297
298
299
300
301
    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
302
303
    return GeniResponse->Create(GENIRESPONSE_SUCCESS, $xml);
}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
304

305
306
307
#
# Use ptopgen in xml mode to spit back an xml file. 
#
308
sub GetAdvertisement($$$$)
309
{
310
    my ($available, $pc, $version, $experiment) = @_;
311
    my $xml = undef;
312
313
    my $gotlock = 0;
    my $filename = "/var/tmp/protogeni_resources.xml";
314

315
316
317
318
319
320
321
    $version = "0.1"
	if ($version eq "PG 0.1");
    $version = "0.2"
	if ($version eq "PG 0.2");
    $version = "2"
	if ($version eq "PG 2");

322
    my $invocation = "$PTOPGEN -x -g $version -r -p GeniSlices";
323
324
325
326
    if (defined($experiment)) {
	my $eid = $experiment->eid();
	$invocation .= " -e $eid";
    }
327
328
329
330
    $invocation .= " -a" unless $available;
    if (defined($pc)) {
	$invocation .= " -1 $pc";
    }
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
    if (!defined($pc)) {
      again:
	#
	# Grab a global script lock. This will ensure that only one ptopgen
	# runs at a time, and everyone else who comes along while that first
	# one is running, will share the same results file.
	#
	# Need to use a well known name, unless we want to share that name
	# via the DB. Lets be simple about it for now.
	#
	if ((my $locked = TBScriptLock("discover", 1)) != TBSCRIPTLOCK_OKAY()) {
	    if ($locked == TBSCRIPTLOCK_IGNORE) {
		#
		# Previous locker finished ptopgen.
		# Grab the file if it exists (small race), otherwise
		# try again from the top.
		#
		if (open(AVAIL, "$filename")) {
		    $xml = "";
		    while (<AVAIL>) {
			$xml .= $_;
		    }
		    close(AVAIL);
		    return $xml;
		}
		goto again;
	    }
	    else {
		print STDERR "Could not get ptopgen lockfile\n";
		return undef;
	    }
	}
	else {
	    #
	    # We got the lock so we get to run ptopgen.
	    #
	    $gotlock = 1;
	}
    }
370
    if (open(AVAIL, "$invocation |")) {
371
	$xml = "";
372
373
374
375
376
	while (<AVAIL>) {
	    $xml .= $_;
	}
	close(AVAIL);
    }
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
    #
    # The lock holder has to create the new version of the file for
    # anyone waiting. Need to do this atomically so that anyone still
    # reading the previous version does not get inconsistent data.
    #
    if ($gotlock) {
	my ($fh, $tempname) = tempfile(UNLINK => 0, DIR => "/var/tmp");
	if (!defined($fh)) {
	    print STDERR "Could not create temporary file: $!\n";
	    $xml = undef;
	}
	else {
	    print $fh $xml;
	    close($fh);
	    if (! rename($tempname, $filename)) {
		print STDERR "Could not rename temporary file: $!\n";
		$xml = undef;
	    }
	}
	TBScriptUnlock();
    }
398
399
400
    return $xml;
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
401
#
402
# Update a ticket with a new rspec.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
403
#
404
sub UpdateTicket($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
405
406
{
    my ($argref) = @_;
407
408
409
410
411
412
413
414
415
416

    return GetTicket($argref, 1);
}

#
# Respond to a GetTicket request. 
#
sub GetTicket($;$)
{
    my ($argref, $isupdate) = @_;
417
    my $rspecstr   = $argref->{'rspec'};
Leigh B. Stoller's avatar
Leigh B. Stoller committed
418
    my $impotent   = $argref->{'impotent'};
419
420
    my $credstr    = $argref->{'credential'};
    my $tickstr    = $argref->{'ticket'};
421
422
423
424
425
426
427
    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
428

429
    if (! defined($credstr)) {
430
	return GeniResponse->MalformedArgsResponse();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
431
    }
432
    if (!defined($rspecstr)) {
433
434
	return GeniResponse->MalformedArgsResponse();
    }
435
436
437
438
    if (! ($rspecstr =~ /^[\040-\176\012\015\011]+$/)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Improper characters in rspec");
    }
439
440
441
442
    my $credential = CheckCredential($credstr);
    return $credential
	if (GeniResponse::IsResponse($credential));

443
    if ($isupdate) {
444
445
446
	$ticket = CheckTicket($tickstr);
	return $ticket
	    if (GeniResponse::IsResponse($ticket));
447
    }
448
    return GetTicketAux($credential,
449
			$rspecstr, $isupdate, $impotent, 0, 1, $ticket);
450
}
451

452
sub GetTicketAux($$$$$$$)
453
{
454
455
    my ($credential, $rspecstr, $isupdate, $impotent, $v2, $level,
	$ticket) = @_;
456
    
457
458
459
460
461
462
    defined($credential) &&
	($credential->HasPrivilege( "pi" ) or
	 $credential->HasPrivilege( "instantiate" ) or
	 $credential->HasPrivilege( "bind" ) or
	 return GeniResponse->Create( GENIRESPONSE_FORBIDDEN, undef,
				      "Insufficient privilege" ));
463
    
464
465
    my $slice_urn = $credential->target_urn();
    my $user_urn  = $credential->owner_urn();
466
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
467
    #
468
    # Create user from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
469
    #
470
    my $user = CreateUserFromCertificate($credential);
471
472
    return $user
	if (GeniResponse::IsResponse($user));
473
474
475

    # Bump activity. Does not matter if request fails ...
    $user->BumpActivity();
476
    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
477
    #
478
    # Create slice from the certificate.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
479
    #
480
481
    my $slice = GeniSlice->Lookup($slice_urn);
    if (!defined($slice)) {
482
	if ($isupdate) {
483
	    print STDERR "Could not locate slice $slice_urn for Update\n";
484
	    return GeniResponse->Create(GENIRESPONSE_ERROR, undef,
485
486
487
					"No slice found for UpdateTicket");
	}
	$slice = CreateSliceFromCertificate($credential, $user);
488
489
	return $slice
	    if (GeniResponse::IsResponse($slice));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
490
    }
491
    
492
    return GetTicketAuxAux($slice, $user, $rspecstr,
493
494
			   $isupdate, $impotent, $v2, $level, $ticket,
			   [$credential]);
495
}
496
sub GetTicketAuxAux($$$$$$$$$)
497
{
498
499
    my ($slice, $user, $rspecstr, 
        $isupdate, $impotent, $v2, $level, $ticket, $credentials) = @_;
500
501
502
    my $response    = undef;
    my $restorevirt = 0;	# Flag to restore virtual state
    my $restorephys = 0;	# Flag to restore physical state
503
504
    require OSinfo;
    require VirtExperiment;
505
506
507
508
509
510

    #
    # We need this below to sign the ticket.
    #
    my $authority = GeniCertificate->LoadFromFile($EMULAB_PEMFILE);
    if (!defined($authority)) {
511
	print STDERR " Could not load authority for $EMULAB_PEMFILE\n";
512
513
514
	return GeniResponse->Create(GENIRESPONSE_ERROR);
    }

515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
    #
    # 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");
    }

533
534
    my $rspec = GeniXML::Parse($rspecstr);
    if (! defined($rspec)) {
535
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
536
				    "Error Parsing rspec XML");
537
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
538

539
540
541
542
543
544
    my $rspecVersion = GeniXML::GetXmlVersion($rspec);
    if (! defined($rspecVersion)) {
	return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "Unknown RSpec Version");
    }

Leigh B. Stoller's avatar
Leigh B. Stoller committed
545
546
547
548
    #
    # A sitevar controls whether external users can get any nodes.
    #
    my $allow_externalusers = 0;
549
    if (!GetSiteVar('protogeni/allow_externalusers', \$allow_externalusers)){
550
551
552
553
554
555
556
557
558
559
560
561
562
563
	    # 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
564
    }
565
566
567

    if (!$allow_externalusers && !$isExempted && !$user->IsLocal()) {
	    return GeniResponse->Create(GENIRESPONSE_UNAVAILABLE, undef,
Leigh B. Stoller's avatar
Leigh B. Stoller committed
568
569
570
571
				    "External users temporarily denied");
    }
    
    #
572
    # For now all tickets expire very quickly (minutes), but once the
Leigh B. Stoller's avatar
Leigh B. Stoller committed
573
    # ticket is redeemed, it will expire according to the rspec request.
574
575
    # If nothing specified in the rspec, then it will expire when the
    # slice record expires, which was given by the expiration time of the
576
577
    # slice credential, or the local policy max_sliver_lifetime. See
    # CreateSliceFromCertificate() in this file.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
578
    #
Jonathon Duerig's avatar
Jonathon Duerig committed
579
    my $expires = GeniXML::GetExpires($rspec);
580
    if (defined($expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
581
582
583
584
585
586
587
588
589
590
591
592
	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");
	}
	
	#
593
	# Do we need a policy limit?
Leigh B Stoller's avatar
Leigh B Stoller committed
594
595
596
597
598
	# A sitevar controls the sliver lifetime.
	#
	my $max_sliver_lifetime = 0;
	if (!GetSiteVar('protogeni/max_sliver_lifetime',
			\$max_sliver_lifetime)){
599
600
	    # Cannot get the value, default it to 90 days.
	    $max_sliver_lifetime = 90;
Leigh B Stoller's avatar
Leigh B Stoller committed
601
602
603
604
605
606
607
608
609
610
611
612
613
	}

	# 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) {
	    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;
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
614
	my $diff = $when - time();
615
616
617
618
619
620
	if ($diff < (60 * 5)) {
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					"such a short life for a sliver? ".
					"More time please.");
	}
	elsif ($diff > (3600 * 24 * $max_sliver_lifetime)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
621
	    return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
622
623
			"expiration is greater then the maximum number ".
			"of minutes " . (60 * 24 * $max_sliver_lifetime));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
624
	}
625
626
627
628
629
630

	#
	# Must be before the slice expires.
	#
	my $slice_expires = $slice->expires();
	if (defined($slice_expires)) {
Leigh B. Stoller's avatar
Leigh B. Stoller committed
631
	    $slice_expires = str2time($slice_expires);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
632
	    if ($when > $slice_expires) {
633
634
635
636
		return GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				    "valid_until is past slice expiration");
	    }
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
637
    }
638
639
640
641
642
643
644

    #
    # Lock the ticket so it cannot be released.
    #
    if (defined($ticket) && $ticket->stored() && $ticket->Lock() != 0) {
	return GeniResponse->BusyResponse("ticket");
    }
645
646
647
    if (defined($ticket)) {
	$ticket->SetSlice($slice);
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
648
649
650
651
652
653
    
    #
    #
    # Lock the slice from further access.
    #
    if ($slice->Lock() != 0) {
654
655
656
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
	return GeniResponse->BusyResponse("slice");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
657
    }
658
659
660
    # Shutdown slices get nothing.
    if ($slice->shutdown()) {
	$slice->UnLock();
661
662
	$ticket->UnLock()
	    if (defined($ticket) && $ticket->stored());
663
664
665
	return GeniResponse->Create(GENIRESPONSE_FORBIDDEN, undef,
				    "Slice has been shutdown");
    }
666
667
668
669
670
671
672
673
    # 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
674

675
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
676
    # For now, there can be only a single toplevel aggregate per slice.
677
    # The existence of an aggregate means the slice is active here. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
678
    #
679
    my $aggregate = GeniAggregate->SliceAggregate($slice);
680
681
682
683
684
    if (!$isupdate) {
	if (defined($aggregate)) {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Already have an aggregate for slice");
	    goto bad;
685
686
	}
    }
687
688
689
690
691
    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;
    }
692

693
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
694
    # We need this now so we can form a virtual topo.
695
    #
696
697
698
699
700
701
702
703
704
705
706
    my $slice_experiment = GeniExperiment($slice, $user);
    if (GeniResponse::IsResponse($slice_experiment)) {
	$response = $slice_experiment;
	$slice_experiment = undef;
	goto bad;
    }
    my $realuser = FlipToUser($slice, $user);
    if (! (defined($realuser) && $realuser)) {
	$response = GeniResponse->Create(GENIRESPONSE_ERROR, undef,
					 "FlipToUser Error");
	print STDERR "Error flipping to real user\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
707
708
709
710
	goto bad;
    }
    my $pid = $slice_experiment->pid();
    my $eid = $slice_experiment->eid();
711
712
713
714
715

    #
    # Mark the experiment locally as coming from the cooked interface.
    # This changes what tmcd returns to the local nodes.
    #
716
    my $generated_by = GeniXML::GetText("generated_by", $rspec);
717
718
    if (defined($generated_by) &&
	$generated_by eq "libvtop") {
719
720
721
722
	$slice_experiment->Update({"geniflags" =>
				       $Experiment::EXPT_GENIFLAGS_EXPT|
				       $Experiment::EXPT_GENIFLAGS_COOKED});
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
723
724
725
726
727
728
729
730
731
732
733
734
735
    
    #
    # 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);
736
    $virtexperiment->multiplex_factor(1);
737

738
739
740
741
742
743
    if ($MAINSITE) {
	$virtexperiment->NewTableRow("virt_vtypes",
				     {"name"     => "pcfast",
				      "members"  => "pc3000 d710",
				      "weight"   => 0.5});
    }
744
745
746
747
748
    # Need to move this someplace else; the parser adds a bunch.
    $virtexperiment->NewTableRow("virt_agents",
				 {"vnode"      => "*",
				  "vname"      => "ns",
				  "objecttype" => "6"});
749

Leigh B. Stoller's avatar
Leigh B. Stoller committed
750
    #
Leigh B. Stoller's avatar
Leigh B. Stoller committed
751
752
    # 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
753
754
    # cannot be granted.
    #
755
756
757
    my %namemap  = ();
    my %colomap  = ();
    my %ifacemap = ();
Jonathon Duerig's avatar
Jonathon Duerig committed
758
    my %iface2node = ();
759
    my %vportmap = ();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
760
    my %nodemap  = ();
761
    my %bridgemap= ();
762
    my @nodeids  = ();
763
    my %lannodes = ();
764
    # For stitching, keep track of external nodes and links.
765
766
767
768
    my %external_nodemap  = ();
    my %external_linkmap  = ();
    my %external_vportmap = ();
    my %stitching_paths   = ();
769
770
771
772
773
774
775
776

    #
    # 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
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
	$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;
	}
795
796
797
798
799
800
801
	my $oldrspec;
	if ($v2 && defined($aggregate)) {
	    $oldrspec = $aggregate->GetManifest(0);
	}
	else {
	    $oldrspec = $ticket->rspec();
	}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
802
	
803
	foreach my $ref (GeniXML::FindNodes("n:node",
804
					    $oldrspec)->get_nodelist()) {
805
	    # Let remote nodes pass through.
806
	    next
807
		if (!GeniXML::IsLocalNode($ref));
808

809
810
	    # Skip lan nodes; they are fake.
	    next
811
		if (GeniXML::IsLanNode($ref));
812

813
	    my $node_nickname = GeniXML::GetVirtualId($ref);
Jonathon Duerig's avatar
Jonathon Duerig committed
814
	    my $colocate      = GeniXML::GetColocate($ref);
815
	    my $component_id  = GeniXML::GetNodeId($ref);
816
817
	    my $vnode_id      = GeniXML::GetVnodeId($ref);
	    my $node = GeniUtil::LookupNode($vnode_id);
818
819
	    if (!defined($node)) {
		$response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
820
				 "Bad resource $component_id in ticket");
821
822
		goto bad;
	    }
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
	    #
	    # Is the node a virtual node? Must be an update to an
	    # existing sliver/ticket, since we now return the node_id
	    # of the allocated virtual node, not the physical node.
	    #
	    if ($node->isvirtnode()) {
		my $pnode = Node->Lookup($node->phys_nodeid());
		if (!defined($pnode)) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "No physical resource for $component_id");
		    goto bad;
		}
		$node = $pnode;
	    }
838
839
840
841
842
	    $namemap{$node_nickname} = $node;
	    $colomap{$colocate} = $node
		if (defined($colocate));
	}
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
843

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

846
847
    my %nodeexistsmap = ();

848
    foreach my $ref (GeniXML::FindNodes("n:node", $rspec)->get_nodelist()) {
849
	my $component_id  = GeniXML::GetNodeId($ref);
850
	my $vnode_id      = GeniXML::GetVnodeId($ref);
851
	my $manager_id    = GeniXML::GetManagerId($ref);
852
	my $node_nickname = GeniXML::GetVirtualId($ref);
Jonathon Duerig's avatar
Jonathon Duerig committed
853
854
855
856
	my $colocate      = GeniXML::GetColocate($ref);
	my $subnode_of    = GeniXML::GetSubnodeOf($ref);
	my $virtualization_type = GeniXML::GetVirtualizationType($ref);
	
857
	my $virtualization_subtype
Jonathon Duerig's avatar
Jonathon Duerig committed
858
859
                          = GeniXML::GetVirtualizationSubtype($ref);
	my $exclusive     = GeniXML::GetExclusive($ref);
860
	my $tarfiles      = GeniXML::GetTarball($ref);
861
	my $pctype;
862
	my $osname;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
863
	my $node;
864
865
866
	my $isbridge    = 0;
	my $isfirewall  = 0;
	
867
868
869
870
871
872
873
874
	if (exists($nodeexistsmap{$node_nickname})) {
	    $response =
		GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Duplicate node $node_nickname");
	    goto bad;
	}
	$nodeexistsmap{$node_nickname} = 1;

875
876
877
878
879
	# Always populate iface2node mapping, even if we let the node
	# pass through.
	foreach my $linkref (GeniXML::FindNodes("n:interface",
						$ref)->get_nodelist()) {
	    my $virtual_id   = GeniXML::GetInterfaceId($linkref);
880
881
882
883
884
885
886
	    if (exists($iface2node{$virtual_id})) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
					 "Duplicate interface $virtual_id on ".
					 "node $node_nickname");
		goto bad;
	    }
887
888
889
	    $iface2node{$virtual_id} = $node_nickname;
	}

890
	# Let remote nodes pass through.
891
892
893
894
	if (! GeniXML::IsLocalNode($ref)) {
	    $external_nodemap{$node_nickname} = $ref;
	    next;
	}
895

896
	#
897
898
899
900
901
	#
	# 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. 
	#
902
	if (GeniXML::IsLanNode($ref)) {
903
904
905
906
	    $lannodes{$node_nickname} = $ref;
	    next;
	}

907
908
909
	#
	# Check for disk_image request. Specified as a URN. 
	#
910
	my $diskref = GeniXML::GetDiskImage($ref);
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
	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;
		}
929
930
		my $osinfo = OSinfo->Lookup($ospid, $os);
		if (!defined($osinfo)) {
931
932
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
933
					     "Unknown image URN: $dname");
934
935
		    goto bad;
		}
936
937
938
939
940
941
		#
		# The OS must be in the current project, or it must
		# be global (okay, shared).
		#
		if (! ($osinfo->shared() ||
		       $osinfo->pid() eq $slice_experiment->pid())) {
942
943
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
944
				 "Insufficient permission to use $osinfo");
945
946
		    goto bad;
		}
947
		
948
949
950
		#
		# This is only going to be used in raw mode. 
		#
951
		$osname = "$ospid/$os";
952
953
954
	    }
	}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
955
956
957
	if (defined($virtualization_type)) {
	    if ($virtualization_type eq "emulab-vnode") {
		if (defined($virtualization_subtype)) {
958
959
		    $pctype = "pcvm";
		    
Leigh B. Stoller's avatar
Leigh B. Stoller committed
960
961
962
963
964
965
		    if ($virtualization_subtype eq "emulab-jail") {
			$osname = "FBSD-JAIL";
		    }
		    elsif ($virtualization_subtype eq "emulab-openvz") {
			$osname = "OPENVZ-STD";
		    }
966
967
968
969
		    elsif ($virtualization_subtype eq "emulab-spp") {
			$osname = "SPPVM-FAKE";
			$pctype = "sppvm";
			# Lets force to shared node.
Jonathon Duerig's avatar
Jonathon Duerig committed
970
			if (! GeniXML::SetExclusive($ref, 0)) {
971
972
973
			    $response
				= GeniResponse->Create(GENIRESPONSE_BADARGS,
						       undef,
974
975
				       "Malformed rspec: ".
				       "Cannot set exclusive tag to false");
976
977
978
			    goto bad;
			}
			$exclusive = 0;
979
980
			# Kludge for libvtop.
			$virtexperiment->multiplex_factor(1);
981
			$virtexperiment->encap_style("vlan");
982
		    }
983
984
985
986
987
988
		    elsif ($virtualization_subtype eq "emulab-bbg") {
			$osname = "BBGENIVM-FAKE";
			$pctype = "bbgenivm";
			# Lets force to shared node.
			GeniXML::SetExclusive($ref, 0);
			$exclusive = 0;
989
			$virtexperiment->multiplex_factor(5);
990
991
			$virtexperiment->encap_style("vlan");
		    }
992
993
		    elsif ($virtualization_subtype eq "raw"
			   || $virtualization_subtype eq "raw-pc") {
994
995
996
			$pctype = undef;
			goto raw;
		    }
997
998
999
1000
		    elsif ($virtualization_subtype eq "delay") {
			$isbridge = 1;
			$pctype   = undef;
		    }
1001
1002
1003
1004
1005
1006
		    elsif ($virtualization_subtype eq "firewall") {
			$isfirewall = 1;
			$osname     = "FW-IPFW2";
			$pctype     = "pc";
			goto raw;
		    }
1007
1008
1009
1010
1011
1012
1013
1014
		    else {
			$response
			    = GeniResponse->Create(GENIRESPONSE_BADARGS,
						   undef,
				       "Malformed rspec: ".
				       "Unknown virtualization_subtype");
			goto bad;
		    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1015
1016
1017
1018
1019
1020
1021
1022
		}
		else {
		    goto raw;
		}
	    }
	    else {
	      raw:
		# Lets force to exclusive real node.
Jonathon Duerig's avatar
Jonathon Duerig committed
1023
		if (! GeniXML::SetExclusive($ref, 1)) {
1024
1025
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
1026
			"Malformed rspec: Cannot set exclusive tag to true");
1027
1028
1029
		    goto bad;
		}
		$exclusive = 1;
1030
1031
1032
1033
1034
		my $subtype = "raw-pc";
		if (GeniXML::IsVersion0($ref)) {
		    $subtype = "raw";
		}
		if (! GeniXML::SetVirtualizationSubtype($ref, $subtype)) {
1035
1036
		    $response = GeniResponse->Create(GENIRESPONSE_BADARGS,
						     undef,
1037
			"Malformed rspec: Cannot set virtualization_type to raw");
1038
1039
		    goto bad;
		}
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1040
1041
1042
1043
	    }
	}
	else {
	    $response = GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1044
				     "Must provide a virtualization_type");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1045
1046
1047
	    goto bad;

	}
1048
1049
1050
1051
1052
1053
	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
1054
	#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1055
	# Allow wildcarding.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1056
	#
1057
	if (!defined($component_id) || $component_id eq "*") {
1058
1059
1060
1061
1062
	    if (defined($colocate) && exists($colomap{$colocate})) {
		$node = $colomap{$colocate};
	    }
	    elsif ($isupdate && exists($namemap{$node_nickname})) {
		$node = $namemap{$node_nickname};
1063
	    }
1064
1065
	    # If the node still isn't bound and doesn't have a pctype,
	    # use the user-specified one.
1066
1067
1068
1069
1070
1071
1072
1073
1074
	    if (GeniXML::IsVersion0($ref)) {
		if (! defined($node) && ! defined($pctype)) {
		    my $usertype = GeniXML::FindFirst("n:node_type", $ref);
		    if (defined($usertype)) {
			$pctype = GeniXML::GetText("type_name", $usertype);
		    }
		}
	    } else {
		my $usertype = GeniXML::FindFirst("n:hardware_type", $ref);
1075
		if (defined($usertype)) {
1076
1077
1078
1079
1080
1081
		    #
		    # Watch for pcvm type set above. If the user specified
		    # a hardware type for their VMs, then form a proper
		    # hardware specific pcvm type. 
		    #
		    my $pt = GeniXML::GetText("name", $usertype);
Leigh B Stoller's avatar
Leigh B Stoller committed
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
		    if (!defined($pt)) {
			$response =
			    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
						 "Bad hardware_type");
			goto bad;
		    }
		    if (defined($pctype) && $pctype eq "pcvm") {
			$pctype = "${pt}-vm";
		    }
		    else {
			$pctype = $pt;
		    }
1094
1095
		}
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1096
1097
	}
	else {
1098
	    $node = GeniUtil::LookupNode($vnode_id);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1099
1100
1101
1102

	    if (!defined($node)) {
		$response =
		    GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
1103
					 "Bad resource $component_id");
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1104
1105
		goto bad;
	    }
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
	    #
	    # Is the node a virtual node? Must be an update to an
	    # existing sliver/ticket, since we now return the node_id
	    # of the allocated virtual node, not the physical node.
	    #
	    if ($node->isvirtnode()) {
		if (!$isupdate ||
		    !exists($namemap{$node_nickname})) {
		    $response =
			GeniResponse->Create(GENIRESPONSE_BADARGS, undef,
				     "Bad resource for $node_nickname");
		    goto bad;
		}
		$node = $namemap{$node_nickname};
	    }
1121
1122
	    $pctype = $node->type()
		if (!defined($pctype));
1123
	}
1124

1125
	#
1126
	# If no osname, check for protogeni default osname
1127
	#
1128
	if (! defined($osname)) {
1129
	    my $protogeni_os = undef;
1130
	    if (GetSiteVar('protogeni/default_osname', \$protogeni_os)
1131
1132
		&& $protogeni_os ne ""
		&& (! defined($pctype) || $pctype ne "bbgeni")) {
1133
		$osname = $protogeni_os;
1134
1135
1136
1137
1138
1139
1140
1141
	    }
	}

	#
	# If no osname by this point, try for the default.
	#
	if (defined($node) && !defined($osname)) {
	    if (defined($node->default_osid())) {
1142
1143
1144
1145
		my $osinfo = OSinfo->Lookup($node->default_osid());
		$osname = $osinfo->osname()
		    if (defined($osinfo));
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1146
	}
1147
1148
1149
	# The slot does not like to be NULL.
	$osname = ""
	    if (!defined($osname));
1150
	
1151
1152
1153
	# Need some kind of default.
	$pctype = "pc"
	    if (!defined($pctype));
1154
	
1155
1156
1157
1158
1159
	my $nodeblob = {"vname"   => $node_nickname,
			"type"    => $pctype,
			"osname"  => $osname,
			"ips"     => '', # deprecated
			"cmd_line"=> '', # bogus
1160
			"routertype" => "static-ddijk",
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1161
1162
			"fixed"   => (defined($subnode_of) ? $subnode_of :
				      defined($node) ? $node->node_id() : ""),
1163
			    
1164
			};
1165

1166
1167
1168
	if ($isbridge) {
	    $nodeblob->{'role'} = "bridge";
	}
1169
1170
1171
1172
1173