GeniEmulabUtil.pm.in 12.1 KB
Newer Older
Leigh B. Stoller's avatar
Leigh B. Stoller committed
1 2
#!/usr/bin/perl -w
#
3
# GENIPUBLIC-COPYRIGHT
4
# Copyright (c) 2008-2011 University of Utah and the Flux Group.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
5 6
# All rights reserved.
#
Leigh B Stoller's avatar
Leigh B Stoller committed
7
package GeniEmulabUtil;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25

#
# Stuff to interface between Emulab core and Geni nodes.
#
use strict;
use Exporter;
use vars qw(@ISA @EXPORT);

@ISA    = "Exporter";
@EXPORT = qw ( );

# Must come after package declaration!
use GeniDB;
use Genixmlrpc;
use GeniResponse;
use GeniTicket;
use GeniCredential;
use GeniCertificate;
26 27 28
use GeniComponent;
use GeniAuthority;
use GeniRegistry;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
29 30 31
use GeniSlice;
use GeniSliver;
use GeniUser;
32
use GeniHRN;
33
use GeniXML;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
34 35 36 37
use libtestbed;
use User;
use Node;
use Interface;
38
use Lan;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
39
use English;
40
use XML::Simple;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
41 42
use Data::Dumper;
use Experiment;
43
use libdb qw(TBDB_IFACEROLE_CONTROL TBDB_IFACEROLE_EXPERIMENT);
44 45
use POSIX qw(strftime);
use Carp;
46
use Socket;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
47 48 49 50 51 52 53 54

# Configure variables
my $TB		   = "@prefix@";
my $TBOPS          = "@TBOPSEMAIL@";
my $TBAPPROVAL     = "@TBAPPROVALEMAIL@";
my $TBAUDIT   	   = "@TBAUDITEMAIL@";
my $BOSSNODE       = "@BOSSNODE@";
my $OURDOMAIN      = "@OURDOMAIN@";
55
my $SACERT         = "$TB/etc/genisa.pem";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
56 57

#
Leigh B. Stoller's avatar
Leigh B. Stoller committed
58
# Initialize for using geni resources.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
59
#
60
sub RegisterExperiment($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
61
{
62 63 64
    my ($experiment, $user) = @_;

    my $slice = GeniSlice->LookupByExperiment($experiment);
65 66 67 68 69 70 71 72 73 74 75 76 77

    #
    # If we have a slice for it, check to see if its expired. We just
    # go ahead and renew it.
    #
    if (defined($slice)) {
	if ($slice->IsExpired() &&
	    $slice->SetExpiration(time() + (24 * 3600 * 30))) {
	    print STDERR "Could not reset slice expiration\n";
	    return -1;
	}
	return 0;
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
78

Leigh B. Stoller's avatar
Leigh B. Stoller committed
79
    #
80
    # Load the SA cert to act as caller context.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
81
    #
82 83 84 85 86 87 88 89 90
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return -1;
    }
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
91
    #
92
    # Set the default RPC context. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
93
    #
94
    Genixmlrpc->SetContext($context);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
95

Leigh B. Stoller's avatar
Leigh B. Stoller committed
96
    #
97
    # Create a Geni user from the supplied Emulab user.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
98
    #
99
    my $geniuser = GeniUser->CreateFromLocal($user);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
100
    if (!defined($geniuser)) {
101
	print STDERR "Could not create a geni user from current user $user\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
102 103 104
	return -1;
    }
    # Register user at the ClearingHouse.
105
    print STDERR "Registering $geniuser at the ClearingHouse.\n";
Leigh B. Stoller's avatar
Leigh B. Stoller committed
106 107 108 109 110 111
    if ($geniuser->Register() != 0) {
	print STDERR "Could not register $geniuser at the ClearingHouse.\n";
	return -1;
    }

    #
112
    # Create and register the slice. Slice is returned locked
Leigh B. Stoller's avatar
Leigh B. Stoller committed
113
    #
114
    print STDERR "Creating new slice for $experiment\n";
115
    $slice = GeniSlice->CreateFromLocal($experiment, $geniuser);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
116
    if (!defined($slice)) {
117 118 119
	print STDERR "Could not create local slice from $experiment\n";
	return -1;
    }
120 121 122 123 124 125 126 127 128 129 130 131 132 133 134
    #
    # We want this slice to have a long expiration and let Emulab
    # deal with aging it out.
    #
    my $expires = time() + (3600 * 24 * 90);
    if ($slice->SetExpiration($expires)) {
	print STDERR "Could not set expiration for $slice\n";

	if ($slice->UnRegister() != 0) {
	    print STDERR "Could not unregister $slice for $experiment\n";
	    return -1;
	}
	$slice->Delete();
	return -1;
    }
135 136 137
    print STDERR "Registering $slice at the ClearingHouse.\n";
    if ($slice->Register() != 0) {
	$slice->Delete();
138
	print STDERR "Could not register slice $slice\n";
139
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
140
    }
141
    $slice->UnLock();
Leigh B. Stoller's avatar
Leigh B. Stoller committed
142 143 144 145
    return 0;
}

#
146
# Delete the slice record from the ClearingHouse and then locally.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
147
#
148
sub UnRegisterExperiment($)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
149
{
150
    my ($experiment) = @_;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
151 152

    my $slice = GeniSlice->LookupByExperiment($experiment);
153 154
    return 0
	if (!defined($slice));
155 156

    #
157
    # Load the SA cert to act as caller context.
158
    #
159 160 161
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
162 163
	return -1;
    }
164 165 166
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
167
	return -1;
168 169
    }
    #
170
    # Set the default RPC context. 
171
    #
172
    Genixmlrpc->SetContext($context);
173

174 175 176 177 178 179 180
    #
    # Its possible the sa_daemon has the slice locked.
    #
    if ($slice->Lock() != 0) {
	print STDERR "Could not lock slice\n";
	return -1;
    }
181 182 183 184
    print STDERR "Unregistering $slice at the ClearingHouse.\n";
    if ($slice->UnRegister() != 0) {
	print STDERR "Could not unregister $slice for $experiment\n";
	return -1;
185
    }
186
    # Needs to move.
187
    GeniSlice::ClientSliver->SliceDelete($slice);
188
    
189 190 191
    if ($slice->Delete()) {
	print STDERR "Could not delete $slice for $experiment\n";
	return -1;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
192 193 194 195 196
    }
    return 0;
}

#
197
# Create a physical node on the fly. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
198
#
199
sub CreatePhysNode($$)
Leigh B. Stoller's avatar
Leigh B. Stoller committed
200
{
201
    my ($manager_urn, $node_urn) = @_;
202 203
    my @ifaces;
    my $ctrliface;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
204

205 206 207 208
    if (!defined($node_urn) || ! GeniHRN::IsValid($node_urn)) {
	carp("Not a proper node urn: $node_urn\n");
	return -1;
    }
209 210 211 212 213
    if (!defined($manager_urn) || ! GeniHRN::IsValid($manager_urn)) {
	carp("Not a proper manager urn: $manager_urn\n");
	return -1;
    }
    print STDERR "$node_urn, $manager_urn\n";
214

215
    my ($auth,$type,$node_id) = GeniHRN::Parse($node_urn);
Leigh B. Stoller's avatar
Leigh B. Stoller committed
216 217

    #
218
    # Load the SA cert to act as caller context.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
219
    #
220 221 222 223
    my $certificate = GeniCertificate->LoadFromFile($SACERT);
    if (!defined($certificate)) {
	print STDERR "Could not load certificate from $SACERT\n";
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
224
    }
225 226 227
    my $context = Genixmlrpc->Context($certificate);
    if (!defined($context)) {
	print STDERR "Could not create context to talk to clearinghouse\n";
228
	return undef;
229
    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
230
    #
231
    # Set the default RPC context. 
Leigh B. Stoller's avatar
Leigh B. Stoller committed
232
    #
233
    Genixmlrpc->SetContext($context);
234

235
    my $authority = GeniAuthority->CreateFromRegistry("CM", $manager_urn);
236
    if (!defined($authority)) {
237 238
	print STDERR "Could not lookup $manager_urn at ClearingHouse\n";
	return undef;
239
    }
240 241 242
    my $manager_version = $authority->Version();
    return undef
	if (!defined($manager_version));
243

244 245
    my $component = GeniComponent->CreateFromRegistry($node_urn);
    if (!defined($component)) {
246
	print STDERR "Could not lookup $node_urn at its registry\n";
247
	return undef;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
248
    }
249
    my $node = Node->LookupWideArea($node_urn);
250 251
    return $node
	if (defined($node));
Leigh B. Stoller's avatar
Leigh B. Stoller committed
252

Leigh B. Stoller's avatar
Leigh B. Stoller committed
253 254
    print STDERR "Creating local node for $node_urn\n";

255 256 257
    my $blob     = $component->Resolve();
    return undef
	if (!defined($blob));
258 259 260

    my $IP       = $blob->{'physctrl'};
    my $hostname = $blob->{'hostname'};
261
    if (! defined($hostname)) {
262
	print STDERR "Missing stuff in blob from CM for $node_urn\n";
263
	goto bad;
264 265 266 267
    }
    if (! ($hostname =~ /^[-\w\.]*$/)) {
	print STDERR
	    "Invalid hostname '$hostname' in blob from CM for $node_urn\n";
268
	goto bad;
269
    }
270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297
    if ($authority->IsSFA()) {
	#
	# Generate a suitable node_id.
	#
	my $site = $blob->{'site'};
	if (! defined($site)) {
	    print STDERR "Missing site in blob from CM for $node_urn\n";
	    goto bad;
	}
	if (! ($site =~ /^[-\w\.]*$/)) {
	    print STDERR "Invalid site '$site' in blob from CM for $node_urn\n";
	    goto bad;
	}
	my @tmp  = split(/\./, $hostname);
	$node_id = $site . "-" . $tmp[0];
    }
    else {
	my $hrn = $blob->{'hrn'};
	if (! defined($hrn)) {
	    print STDERR "Missing hrn in blob from CM for $node_urn\n";
	    goto bad;
	}
	if (! ($hrn =~ /^[-\w\.]*$/)) {
	    print STDERR "Invalid hrn '$hrn' in blob from CM for $node_urn\n";
	    goto bad;
	}
	$node_id = $hrn;
    }
298 299 300
    $node_id =~ s/\./\-/g;
    if (length($node_id) > 32) {
	print STDERR "Nodeid '$node_id' too long for $node_urn\n";
301
	goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
302 303 304
    }

    #
305
    # Find control network.
Leigh B. Stoller's avatar
Leigh B. Stoller committed
306
    #
307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328
    if ($authority->IsSFA()) {
	#
	# Find the IP from the hostname and generate a stub iface entry.
	#
	my ($name,undef,undef,undef,@ipaddrs) = gethostbyname($hostname);
	if (!defined($name)) {
	    print STDERR "Cannot resolve $hostname for $node_urn:\n";
	    goto bad;
	}
	$IP = inet_ntoa($ipaddrs[0]);

	my $ifaceargs = {
	    "card"      => 0,
	    "role"      => TBDB_IFACEROLE_CONTROL(),
	    "MAC"       => '000000000000',
	    "IP"        => $IP,
	    "type"      => "generic",
	};
	push(@ifaces, $ifaceargs);
	$ctrliface = $ifaceargs;
    }
    elsif (exists($blob->{'interfaces'})) {
329
	foreach my $ref (@{ $blob->{'interfaces'} }) {
330 331 332 333 334 335 336 337 338 339 340 341 342 343 344
	    my $role = $ref->{'role'};
	    
	    if ($role eq "ctrl" || $role eq "control") {
		$IP = $ref->{'IP'};

		#
		# This turns out to be a problem; if the node is actually
		# on the local cluster (we treat all protogeni nodes same),
		# we end up with two nodes in the interfaces table with the
		# same IP; not allowed since stuff breaks (bootinfo, tmcd).
		#
		next;
	    }
	    if ($role eq TBDB_IFACEROLE_CONTROL() ||
		$role eq TBDB_IFACEROLE_EXPERIMENT()) {
345 346 347
		my $MAC = $ref->{'MAC'};
		if (!defined($MAC) || !($MAC =~ /^[:\w]*$/)) {
		    print STDERR "Bad mac in blob for $node_urn:\n";
348 349 350 351 352 353 354 355 356 357 358
		    goto bad;
		}
		my $IIP = $ref->{'IP'};
		if (!defined($IIP) || !($IIP =~ /^[-\w\.]*$/)) {
		    print STDERR "Bad IP in blob for $node_urn:\n";
		    goto bad;
		}
		my ($card) = ($ref->{'iface'} =~ /^\D*(\d*)$/);
		if (!defined($card)) {
		    print STDERR "Bad iface in blob for $node_urn:\n";
		    goto bad;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
359
		}
360 361 362 363
		
		my $ifaceargs = {
		    "card"      => $card,
		    "role"      => $ref->{'role'},
364
		    "MAC"       => $MAC,
365
		    "IP"        => $IIP,
366
		    "type"      => "generic",
367
		};
368 369 370 371
		push(@ifaces, $ifaceargs);

		$ctrliface = $ifaceargs
		    if ($ref->{'role'} eq TBDB_IFACEROLE_CONTROL());
Leigh B. Stoller's avatar
Leigh B. Stoller committed
372 373
	    }
	}
374 375
    }
    elsif (exists($blob->{'rspec'})) {
376 377 378 379
	my $rspec = GeniXML::Parse($blob->{'rspec'});
	if (!defined($rspec)) {
	    goto bad;
	}
380
	foreach my $noderef (GeniXML::FindNodes("n:node",
381
						$rspec)->get_nodelist()) {
382
	    next
383
		if (GeniXML::GetNodeId($noderef) ne $node_urn);
384
	    next
385
		if (! defined(GeniXML::FindFirst("n:interface", $noderef)));
386 387 388

	    my $count = 0;
	    
389
	    foreach my $ref (GeniXML::FindNodes("n:interface",
390
						$noderef)->get_nodelist()) {
391 392
		my $component_id = GeniXML::GetText("component_id", $ref);
		my $role = GeniXML::GetText("role", $ref);
393 394 395 396 397 398
		if (!defined($role) ||
		    $role eq "experimental" || $role eq "expt") {
		    $role = TBDB_IFACEROLE_EXPERIMENT();
		}
		elsif ($role eq "ctrl" || $role eq "control") {
		    $role = TBDB_IFACEROLE_CONTROL();
399 400 401 402 403 404 405 406 407 408 409

		    my $ipv4 = GeniXML::GetText("public_ipv4", $ref);
		    $IP = $ipv4;

		    #
		    # This turns out to be a problem; if the node is actually
		    # on the local cluster (we treat all protogeni nodes same),
		    # we end up with two nodes in the interfaces table with the
		    # same IP; not allowed since stuff breaks (bootinfo, tmcd).
		    #
		    next;
410 411 412 413
		}
		else {
		    print STDERR "Unknown role $role for $node_urn!\n";
		    goto bad;
414
		}
415 416 417 418 419 420 421 422 423 424
		my $MAC  = "00000000000" . $count;

		my ($auth,$id,$iface) = GeniHRN::ParseInterface($component_id);

		my $ifaceargs = {
		    "card"      => $count,
		    "iface"     => $iface,
		    "role"      => $role,
		    "MAC"       => $MAC,
		    "IP"        => '',
425
		    "type"      => "generic",
426 427 428
		};
		push(@ifaces, $ifaceargs);

429 430
		if ($role eq TBDB_IFACEROLE_CONTROL()) {
		    my $ipv4 = GeniXML::GetText("public_ipv4", $ref);
431
		    $ctrliface = $ifaceargs;
432
		    $ifaceargs->{'IP'}   = $ipv4;
433 434
		}
		$count++;
Leigh B. Stoller's avatar
Leigh B. Stoller committed
435
		#print Dumper($ifaceargs);
436
	    }
Leigh B. Stoller's avatar
Leigh B. Stoller committed
437 438
	}
    }
439 440 441 442
    if (! @ifaces) {
	print STDERR "No interfaces in blob for $node_urn!\n";
	goto bad;
    }
443
    if (!defined($IP)) {
444 445 446
	print STDERR "No control interface in blob for $node_urn!\n";
	goto bad;
    }		   
447 448 449 450
    if (! ($IP =~ /^[-\w\.]*$/)) {
	print STDERR "Invalid IP '$IP' in blob from CM for $node_urn\n";
	goto bad;
    }
451 452 453 454 455 456 457 458
    my $newnode = Node->Create($node_id, undef,
			       {"role"      => "testnode",
				"type"      => "pcfedphys",
				"hostname"  => $hostname,
				"external_node_id" => $node_urn,
				"IP"        => $IP});
    if (!defined($newnode)) {
	print STDERR "Could not create new node from blob for $node_urn\n";
459
	goto bad;
460
    }
461 462 463 464 465 466 467 468 469
    foreach my $ifaceargs (@ifaces) {
	my $interface = Interface->Create($newnode, $ifaceargs);
	if (!defined($interface)) {
	    $newnode->Delete();
	    print STDERR
		"Could not create interface from blob for $node_urn\n";
	    print STDERR Dumper($ifaceargs);
	    goto bad;
	}
470
    }
471
    return $newnode;
472 473 474
  bad:
    print STDERR Dumper($blob);
    return undef;
475 476
}

Leigh B. Stoller's avatar
Leigh B. Stoller committed
477 478 479
# _Always_ make sure that this 1 is at the end of the file...
1;